home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / mac / tclMacOSA.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  76.5 KB  |  2,938 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclMacOSA.c --
  3.  *
  4.  *    This contains the initialization routines, and the implementation of
  5.  *    the OSA and Component commands.  These commands allow you to connect
  6.  *    with the AppleScript or any other OSA component to compile and execute
  7.  *    scripts.
  8.  *
  9.  * Copyright (c) 1996 Lucent Technologies and Jim Ingham
  10.  * Copyright (c) 1997 Sun Microsystems, Inc.
  11.  *
  12.  * See the file "License Terms" for information on usage and redistribution
  13.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14.  *
  15.  * SCCS: @(#) tclMacOSA.c 1.7 97/06/18 14:29:58
  16.  */
  17.  
  18. #define MAC_TCL
  19.  
  20. #include <Aliases.h>
  21. #include <string.h>
  22. #include <AppleEvents.h>
  23. #include <AppleScript.h>
  24. #include <OSA.h>
  25. #include <OSAGeneric.h>
  26. #include <Script.h>
  27.  
  28. #include <FullPath.h>
  29. #include <components.h>
  30.  
  31. #include <resources.h>
  32. #include <FSpCompat.h>
  33. /* 
  34.  * The following two Includes are from the More Files package.
  35.  */
  36. #include <MoreFiles.h>
  37. #include <FullPath.h>
  38.  
  39. #include "tcl.h"
  40. #include "tclInt.h"
  41.  
  42. /*
  43.  * I need this only for the call to FspGetFullPath,
  44.  * I'm really not poking my nose where it does not belong!
  45.  */
  46. #include "tclMacInt.h"
  47.  
  48. /*
  49.  * Data structures used by the OSA code.
  50.  */
  51. typedef struct tclOSAScript {
  52.     OSAID scriptID;
  53.     OSType languageID;
  54.     long modeFlags;
  55. } tclOSAScript;
  56.  
  57. typedef struct tclOSAContext {
  58.     OSAID contextID;
  59. } tclOSAContext;
  60.  
  61. typedef struct tclOSAComponent {
  62.     char *theName;
  63.     ComponentInstance theComponent; /* The OSA Component represented */
  64.     long componentFlags;
  65.     OSType languageID;
  66.     char *languageName;
  67.     Tcl_HashTable contextTable;    /* Hash Table linking the context names & ID's */
  68.     Tcl_HashTable scriptTable;
  69.     Tcl_Interp *theInterp;
  70.     OSAActiveUPP defActiveProc;
  71.     long defRefCon;
  72. } tclOSAComponent;
  73.  
  74. /*
  75.  * Prototypes for static procedures. 
  76.  */
  77.  
  78. static pascal OSErr    TclOSAActiveProc _ANSI_ARGS_((long refCon));
  79. static int        TclOSACompileCmd _ANSI_ARGS_((Tcl_Interp *interp,
  80.                  tclOSAComponent *OSAComponent, int argc,
  81.                 char **argv));
  82. static int         tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp,
  83.                 tclOSAComponent *OSAComponent, int argc,
  84.                 char **argv));
  85. static int         tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp,
  86.                 tclOSAComponent *OSAComponent, int argc,
  87.                 char **argv));
  88. static int         tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp,
  89.                 tclOSAComponent *OSAComponent, int argc,
  90.                 char **argv));
  91. static int         tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp,
  92.                 tclOSAComponent *OSAComponent, int argc,
  93.                 char **argv));
  94. static int         tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp,
  95.                 tclOSAComponent *OSAComponent, int argc,
  96.                 char **argv));
  97. static int         tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp,
  98.                 tclOSAComponent *OSAComponent, int argc,
  99.                 char **argv));
  100. static int         tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp,
  101.                 tclOSAComponent *OSAComponent, int argc, char
  102.                 **argv));
  103. static void        GetRawDataFromDescriptor _ANSI_ARGS_((AEDesc *theDesc,
  104.                 Ptr destPtr, Size destMaxSize, Size *actSize));
  105. static OSErr         GetCStringFromDescriptor _ANSI_ARGS_((
  106.                 AEDesc *sourceDesc, char *resultStr,
  107.                 Size resultMaxSize,Size *resultSize));
  108. static int         Tcl_OSAComponentCmd _ANSI_ARGS_((ClientData clientData,
  109.                 Tcl_Interp *interp, int argc, char **argv)); 
  110. static void         getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable,
  111.                 char *pattern, Tcl_DString *theResult));
  112. static int         ASCIICompareProc _ANSI_ARGS_((const void *first,
  113.                 const void *second));
  114. static int         Tcl_OSACmd _ANSI_ARGS_((ClientData clientData,
  115.                 Tcl_Interp *interp, int argc, char **argv)); 
  116. static void         tclOSAClose _ANSI_ARGS_((ClientData clientData));
  117. static void         tclOSACloseAll _ANSI_ARGS_((ClientData clientData));
  118. static tclOSAComponent *tclOSAMakeNewComponent _ANSI_ARGS_((Tcl_Interp *interp,
  119.                 char *cmdName, char *languageName,
  120.                 OSType scriptSubtype, long componentFlags));  
  121. static int         prepareScriptData _ANSI_ARGS_((int argc, char **argv,
  122.                 Tcl_DString *scrptData ,AEDesc *scrptDesc)); 
  123. static void         tclOSAResultFromID _ANSI_ARGS_((Tcl_Interp *interp,
  124.                 ComponentInstance theComponent, OSAID resultID));
  125. static void         tclOSAASError _ANSI_ARGS_((Tcl_Interp * interp,
  126.                 ComponentInstance theComponent, char *scriptSource));
  127. static int         tclOSAGetContextID _ANSI_ARGS_((tclOSAComponent *theComponent, 
  128.                 char *contextName, OSAID *theContext));
  129. static void         tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
  130.                 char *contextName, const OSAID theContext));                        
  131. static int         tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent, 
  132.                 char *contextName, OSAID *theContext));                        
  133. static int         tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent,
  134.                 char *contextName)); 
  135. static int         tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp, 
  136.                 tclOSAComponent *theComponent, char *resourceName, 
  137.                 int resourceNumber, char *fileName,OSAID *resultID));
  138. static int         tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp, 
  139.                 tclOSAComponent *theComponent, char *resourceName, 
  140.                 int resourceNumber, char *fileName,char *scriptName));
  141. static int         tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent,
  142.                 char *scriptName, long modeFlags, OSAID scriptID));         
  143. static int         tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent,
  144.                 char *scriptName, OSAID *scriptID)); 
  145. static tclOSAScript *    tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent,
  146.                 char *scriptName)); 
  147. static int         tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent,
  148.                 char *scriptName,char *errMsg));
  149.  
  150. /*
  151.  * "export" is a MetroWerks specific pragma.  It flags the linker that  
  152.  * any symbols that are defined when this pragma is on will be exported 
  153.  * to shared libraries that link with this library.
  154.  */
  155.  
  156.  
  157. #pragma export on
  158. int Tclapplescript_Init( Tcl_Interp *interp );
  159. #pragma export reset
  160.  
  161. /*
  162.  *----------------------------------------------------------------------
  163.  *
  164.  * Tclapplescript_Init --
  165.  *
  166.  *    Initializes the the OSA command which opens connections to
  167.  *    OSA components, creates the AppleScript command, which opens an 
  168.  *    instance of the AppleScript component,and constructs the table of
  169.  *    available languages.
  170.  *
  171.  * Results:
  172.  *    A standard Tcl result.
  173.  *
  174.  * Side Effects:
  175.  *    Opens one connection to the AppleScript component, if 
  176.  *    available.  Also builds up a table of available OSA languages,
  177.  *    and creates the OSA command.
  178.  *
  179.  *----------------------------------------------------------------------
  180.  */
  181.  
  182. int 
  183. Tclapplescript_Init(
  184.     Tcl_Interp *interp)        /* Tcl interpreter. */
  185. {
  186.     char *errMsg = NULL;
  187.     OSErr myErr = noErr;
  188.     Boolean gotAppleScript = false;
  189.     Boolean GotOneOSALanguage = false;
  190.     ComponentDescription compDescr = {
  191.     kOSAComponentType,
  192.     (OSType) 0,
  193.     (OSType) 0,
  194.     (long) 0,
  195.     (long) 0
  196.     }, *foundComp;
  197.     Component curComponent = (Component) 0;
  198.     ComponentInstance curOpenComponent;
  199.     Tcl_HashTable *ComponentTable;
  200.     Tcl_HashTable *LanguagesTable;
  201.     Tcl_HashEntry *hashEntry;
  202.     int newPtr;
  203.     AEDesc componentName = { typeNull, NULL };
  204.     char nameStr[32];            
  205.     Size nameLen;
  206.     long appleScriptFlags;
  207.     
  208.     /* 
  209.      * Here We Will Get The Available Osa Languages, Since They Can Only Be 
  210.      * Registered At Startup...  If You Dynamically Load Components, This
  211.      * Will Fail, But This Is Not A Common Thing To Do.
  212.      */
  213.      
  214.     LanguagesTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
  215.     
  216.     if (LanguagesTable == NULL) {
  217.     panic("Memory Error Allocating Languages Hash Table");
  218.     }
  219.     
  220.     Tcl_SetAssocData(interp, "OSAScript_LangTable", NULL, LanguagesTable);
  221.     Tcl_InitHashTable(LanguagesTable, TCL_STRING_KEYS);
  222.     
  223.             
  224.     while ((curComponent = FindNextComponent(curComponent, &compDescr)) != 0) {
  225.     int nbytes = sizeof(ComponentDescription);
  226.     foundComp = (ComponentDescription *)
  227.         ckalloc(sizeof(ComponentDescription));
  228.     myErr = GetComponentInfo(curComponent, foundComp, NULL, NULL, NULL);
  229.     if (foundComp->componentSubType ==
  230.         kOSAGenericScriptingComponentSubtype) {
  231.         /* Skip the generic component */
  232.         ckfree((char *) foundComp);
  233.     } else {
  234.         GotOneOSALanguage = true;
  235.  
  236.         /*
  237.          * This is gross: looks like I have to open the component just  
  238.          * to get its name!!! GetComponentInfo is supposed to return
  239.          * the name, but AppleScript always returns an empty string.
  240.          */
  241.              
  242.         curOpenComponent = OpenComponent(curComponent);
  243.         if (curOpenComponent == NULL) {
  244.         Tcl_AppendResult(interp,"Error opening component",
  245.             (char *) NULL);
  246.         return TCL_ERROR;
  247.         }
  248.              
  249.         myErr = OSAScriptingComponentName(curOpenComponent,&componentName);
  250.         if (myErr == noErr) {
  251.         myErr = GetCStringFromDescriptor(&componentName,
  252.             nameStr, 31, &nameLen);
  253.         AEDisposeDesc(&componentName);
  254.         }
  255.         CloseComponent(curOpenComponent);
  256.  
  257.         if (myErr == noErr) {
  258.         hashEntry = Tcl_CreateHashEntry(LanguagesTable,
  259.             nameStr, &newPtr);
  260.         Tcl_SetHashValue(hashEntry, (ClientData) foundComp);
  261.         } else {
  262.         Tcl_AppendResult(interp,"Error getting componentName.",
  263.             (char *) NULL);
  264.         return TCL_ERROR;
  265.         }
  266.             
  267.         /*
  268.          * Make sure AppleScript is loaded, otherwise we will
  269.          * not bother to make the AppleScript command.
  270.          */
  271.         if (foundComp->componentSubType == kAppleScriptSubtype) {
  272.         appleScriptFlags = foundComp->componentFlags;
  273.         gotAppleScript = true;
  274.         }            
  275.     }
  276.     }                
  277.  
  278.     /*
  279.      * Create the OSA command.
  280.      */
  281.     
  282.     if (!GotOneOSALanguage) {
  283.     Tcl_AppendResult(interp,"Could not find any OSA languages",
  284.         (char *) NULL);
  285.     return TCL_ERROR;
  286.     }
  287.     
  288.     /*
  289.      * Create the Component Assoc Data & put it in the interpreter.
  290.      */
  291.     
  292.     ComponentTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
  293.     
  294.     if (ComponentTable == NULL) {
  295.     panic("Memory Error Allocating Hash Table");
  296.     }
  297.     
  298.     Tcl_SetAssocData(interp, "OSAScript_CompTable", NULL, ComponentTable);
  299.             
  300.     Tcl_InitHashTable(ComponentTable, TCL_STRING_KEYS);
  301.  
  302.     /*
  303.      * The OSA command is not currently supported.     
  304.     Tcl_CreateCommand(interp, "OSA", Tcl_OSACmd, (ClientData) NULL,
  305.         (Tcl_CmdDeleteProc *) NULL);
  306.      */
  307.      
  308.     /* 
  309.      * Open up one AppleScript component, with a default context
  310.      * and tie it to the AppleScript command.
  311.      * If the user just wants single-threaded AppleScript execution
  312.      * this should be enough.
  313.      *
  314.      */
  315.      
  316.     if (gotAppleScript) {
  317.     if (tclOSAMakeNewComponent(interp, "AppleScript",
  318.         "AppleScript English", kAppleScriptSubtype,
  319.         appleScriptFlags) == NULL ) {
  320.         return TCL_ERROR;
  321.     }
  322.     }
  323.  
  324.     return Tcl_PkgProvide(interp, "OSAConnect", "1.0");
  325. }
  326.  
  327. /*
  328.  *---------------------------------------------------------------------- 
  329.  *
  330.  * Tcl_OSACmd --
  331.  *
  332.  *    This is the command that provides the interface to the OSA
  333.  *    component manager.  The subcommands are: close: close a component, 
  334.  *    info: get info on components open, and open: get a new connection
  335.  *    with the Scripting Component
  336.  *
  337.  * Results:
  338.  *      A standard Tcl result.
  339.  *
  340.  * Side effects:
  341.  *      Depends on the subcommand, see the user documentation
  342.  *    for more details.
  343.  *
  344.  *----------------------------------------------------------------------
  345.  */
  346.  
  347. int 
  348. Tcl_OSACmd(
  349.     ClientData clientData,
  350.     Tcl_Interp *interp,
  351.     int argc,
  352.     char **argv)
  353. {
  354.     static unsigned short componentCmdIndex = 0;
  355.     char autoName[32];
  356.     char c;
  357.     int length;
  358.     Tcl_HashTable *ComponentTable = NULL;
  359.     
  360.  
  361.     if (argc == 1) {
  362.     Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  363.         argv[0], " option\"", (char *) NULL);
  364.     return TCL_ERROR;
  365.     }
  366.     
  367.     c = *argv[1];
  368.     length = strlen(argv[1]);
  369.     
  370.     /*
  371.      * Query out the Component Table, since most of these commands use it...
  372.      */
  373.     
  374.     ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
  375.         "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
  376.     
  377.     if (ComponentTable == NULL) {
  378.     Tcl_AppendResult(interp, "Error, could not get the Component Table",
  379.         " from the Associated data.", (char *) NULL);
  380.     return TCL_ERROR;
  381.     }
  382.     
  383.     if (c == 'c' && strncmp(argv[1],"close",length) == 0) {
  384.     Tcl_HashEntry *hashEntry;
  385.     if (argc != 3) {
  386.         Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  387.             argv[0], " ",argv[1], " componentName\"",
  388.             (char *) NULL);
  389.         return TCL_ERROR;
  390.     }
  391.         
  392.     if ((hashEntry = Tcl_FindHashEntry(ComponentTable,argv[2])) == NULL) {
  393.         Tcl_AppendResult(interp, "Component \"", argv[2], "\" not found",
  394.             (char *) NULL);
  395.         return TCL_ERROR;
  396.     } else {
  397.         Tcl_DeleteCommand(interp,argv[2]);
  398.         return TCL_OK;
  399.     }
  400.     } else if (c == 'o' && strncmp(argv[1],"open",length) == 0) {
  401.     /*
  402.      * Default language is AppleScript.
  403.      */
  404.     OSType scriptSubtype = kAppleScriptSubtype;
  405.     char *languageName = "AppleScript English";
  406.     char *errMsg = NULL;
  407.     ComponentDescription *theCD;
  408.  
  409.     argv += 2;
  410.     argc -= 2;
  411.          
  412.     while (argc > 0 ) {
  413.         if (*argv[0] == '-') {
  414.         c = *(argv[0] + 1);
  415.         if (c == 'l' && strcmp(argv[0] + 1, "language") == 0) {
  416.             if (argc == 1) {
  417.             Tcl_AppendResult(interp,
  418.                 "Error - no language provided for the -language switch",
  419.                 (char *) NULL);
  420.             return TCL_ERROR;
  421.             } else {
  422.             Tcl_HashEntry *hashEntry;
  423.             Tcl_HashSearch search;
  424.             Boolean gotIt = false;
  425.             Tcl_HashTable *LanguagesTable;
  426.                         
  427.             /*
  428.              * Look up the language in the languages table
  429.              * Do a simple strstr match, so AppleScript
  430.              * will match "AppleScript English"...
  431.              */
  432.                         
  433.             LanguagesTable = Tcl_GetAssocData(interp,
  434.                 "OSAScript_LangTable",
  435.                 (Tcl_InterpDeleteProc **) NULL);
  436.                             
  437.             for (hashEntry =
  438.                  Tcl_FirstHashEntry(LanguagesTable, &search);
  439.                  hashEntry != NULL;
  440.                  hashEntry = Tcl_NextHashEntry(&search)) {
  441.                 languageName = Tcl_GetHashKey(LanguagesTable,
  442.                     hashEntry);
  443.                 if (strstr(languageName,argv[1]) != NULL) {
  444.                 theCD = (ComponentDescription *)
  445.                     Tcl_GetHashValue(hashEntry);
  446.                 gotIt = true;
  447.                 break;
  448.                 }
  449.             }
  450.             if (!gotIt) {
  451.                 Tcl_AppendResult(interp,
  452.                     "Error, could not find the language \"",
  453.                     argv[1],
  454.                     "\" in the list of known languages.",
  455.                     (char *) NULL);
  456.                 return TCL_ERROR;
  457.             }
  458.             }
  459.         }
  460.         argc -= 2;
  461.         argv += 2;                
  462.         } else {
  463.         Tcl_AppendResult(interp, "Expected a flag, but got ",
  464.             argv[0], (char *) NULL);
  465.         return TCL_ERROR;
  466.         }
  467.     }
  468.             
  469.     sprintf(autoName, "OSAComponent%-d", componentCmdIndex++);
  470.     if (tclOSAMakeNewComponent(interp, autoName, languageName,
  471.         theCD->componentSubType, theCD->componentFlags) == NULL ) {
  472.         return TCL_ERROR;
  473.     } else {
  474.         Tcl_SetResult(interp,autoName,TCL_VOLATILE);
  475.         return TCL_OK;    
  476.     }
  477.         
  478.     } else if (c == 'i' && strncmp(argv[1],"info",length) == 0) {
  479.     if (argc == 2) {
  480.         Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  481.             argv[0], " ", argv[1], " what\"",
  482.             (char *) NULL);
  483.         return TCL_ERROR;
  484.     }
  485.              
  486.     c = *argv[2];
  487.     length = strlen(argv[2]);
  488.         
  489.     if (c == 'c' && strncmp(argv[2], "components", length) == 0) {
  490.         Tcl_DString theResult;
  491.             
  492.         Tcl_DStringInit(&theResult);
  493.             
  494.         if (argc == 3) {
  495.         getSortedHashKeys(ComponentTable,(char *) NULL, &theResult);
  496.         } else if (argc == 4) {
  497.         getSortedHashKeys(ComponentTable, argv[3], &theResult);
  498.         } else {
  499.         Tcl_AppendResult(interp, "Error: wrong # of arguments",
  500.             ", should be \"", argv[0], " ", argv[1], " ",
  501.             argv[2], " ?pattern?\".", (char *) NULL);
  502.         return TCL_ERROR;
  503.         }
  504.         Tcl_DStringResult(interp, &theResult);
  505.         return TCL_OK;            
  506.     } else if (c == 'l' && strncmp(argv[2],"languages",length) == 0) {
  507.         Tcl_DString theResult;
  508.         Tcl_HashTable *LanguagesTable;
  509.             
  510.         Tcl_DStringInit(&theResult);
  511.         LanguagesTable = Tcl_GetAssocData(interp,
  512.             "OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL);
  513.                             
  514.         if (argc == 3) {
  515.         getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult);
  516.         } else if (argc == 4) {
  517.         getSortedHashKeys(LanguagesTable, argv[3], &theResult);
  518.         } else {
  519.         Tcl_AppendResult(interp, "Error: wrong # of arguments",
  520.             ", should be \"", argv[0], " ", argv[1], " ",
  521.             argv[2], " ?pattern?\".", (char *) NULL);
  522.         return TCL_ERROR;
  523.         }
  524.         Tcl_DStringResult(interp,&theResult);
  525.         return TCL_OK;            
  526.     } else {
  527.         Tcl_AppendResult(interp, "Unknown option: ", argv[2],
  528.             " for OSA info, should be one of",
  529.             " \"components\" or \"languages\"",
  530.             (char *) NULL);
  531.         return TCL_ERROR;
  532.     }
  533.     } else {
  534.     Tcl_AppendResult(interp, "Unknown option: ", argv[1],
  535.         ", should be one of \"open\", \"close\" or \"info\".",
  536.         (char *) NULL);
  537.     return TCL_ERROR;
  538.     }
  539.     return TCL_OK;
  540. }
  541.  
  542. /* 
  543.  *----------------------------------------------------------------------
  544.  *
  545.  * Tcl_OSAComponentCmd --
  546.  *
  547.  *    This is the command that provides the interface with an OSA
  548.  *    component.  The sub commands are:
  549.  *    - compile ? -context context? scriptData
  550.  *        compiles the script data, returns the ScriptID
  551.  *    - decompile ? -context context? scriptData
  552.  *        decompiles the script data, source code
  553.  *    - execute ?-context context? scriptData
  554.  *        compiles and runs script data
  555.  *    - info what: get component info
  556.  *    - load ?-flags values? fileName
  557.  *        loads & compiles script data from fileName
  558.  *    - run scriptId ?options?
  559.  *        executes the compiled script 
  560.  *
  561.  * Results:
  562.  *    A standard Tcl result
  563.  *
  564.  * Side Effects:
  565.  *    Depends on the subcommand, see the user documentation
  566.  *    for more details.
  567.  *
  568.  *----------------------------------------------------------------------
  569.  */
  570.  
  571. int 
  572. Tcl_OSAComponentCmd(
  573.     ClientData clientData,
  574.     Tcl_Interp *interp, 
  575.     int argc,
  576.     char **argv)
  577. {
  578.     int length;
  579.     char c;
  580.     
  581.     tclOSAComponent *OSAComponent = (tclOSAComponent *) clientData;
  582.     
  583.     if (argc == 1) {
  584.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  585.         argv[0], " option ?arg ...?\"",
  586.         (char *) NULL);
  587.     return TCL_ERROR;
  588.     }
  589.     
  590.     c = *argv[1];
  591.     length = strlen(argv[1]);
  592.     if (c == 'c' && strncmp(argv[1], "compile", length) == 0) {
  593.     return TclOSACompileCmd(interp, OSAComponent, argc, argv);
  594.     } else if (c == 'l' && strncmp(argv[1], "load", length) == 0) {
  595.     return tclOSALoadCmd(interp, OSAComponent, argc, argv);
  596.     } else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) {
  597.     return tclOSAExecuteCmd(interp, OSAComponent, argc, argv);
  598.     } else if (c == 'i' && strncmp(argv[1], "info", length) == 0) {
  599.     return tclOSAInfoCmd(interp, OSAComponent, argc, argv);
  600.     } else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) {
  601.     return tclOSADecompileCmd(interp, OSAComponent, argc, argv);
  602.     } else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) {
  603.     return tclOSADeleteCmd(interp, OSAComponent, argc, argv);
  604.     } else if (c == 'r' && strncmp(argv[1], "run", length) == 0) {
  605.     return tclOSARunCmd(interp, OSAComponent, argc, argv);
  606.     } else if (c == 's' && strncmp(argv[1], "store", length) == 0) {
  607.     return tclOSAStoreCmd(interp, OSAComponent, argc, argv);
  608.     } else {
  609.     Tcl_AppendResult(interp,"bad option \"", argv[1],
  610.         "\": should be compile, decompile, delete, ",
  611.          "execute, info, load, run or store",
  612.          (char *) NULL);
  613.     return TCL_ERROR;
  614.     }
  615.  
  616.     return TCL_OK;
  617. }
  618.  
  619. /*
  620.  *----------------------------------------------------------------------
  621.  *
  622.  * TclOSACompileCmd --
  623.  *
  624.  *    This is the compile subcommand for the component command.
  625.  *
  626.  * Results:
  627.  *    A standard Tcl result
  628.  *
  629.  * Side Effects:
  630.  *      Compiles the script data either into a script or a script
  631.  *    context.  Adds the script to the component's script or context
  632.  *    table.  Sets interp's result to the name of the new script or
  633.  *    context.
  634.  *
  635.  *----------------------------------------------------------------------
  636.  */
  637.  
  638. static int 
  639. TclOSACompileCmd(
  640.     Tcl_Interp *interp,
  641.     tclOSAComponent *OSAComponent,
  642.     int argc,
  643.     char **argv)
  644. {
  645.     int  tclError = TCL_OK;
  646.     int augment = 1;
  647.     int makeContext = 0;
  648.     char c;
  649.     char autoName[16];
  650.     char buffer[32];
  651.     char *resultName;
  652.     Boolean makeNewContext = false;
  653.     Tcl_DString scrptData;
  654.     AEDesc scrptDesc = { typeNull, NULL };
  655.     long modeFlags = kOSAModeCanInteract;
  656.     OSAID resultID = kOSANullScript;
  657.     OSAID contextID = kOSANullScript;
  658.     OSAID parentID = kOSANullScript;
  659.     OSAError osaErr = noErr;
  660.     
  661.     if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) {
  662.     Tcl_AppendResult(interp,
  663.         "OSA component does not support compiling",
  664.         (char *) NULL);
  665.     return TCL_ERROR;
  666.     }
  667.  
  668.     /* 
  669.      * This signals that we should make up a name, which is the
  670.      * default behavior:
  671.      */
  672.      
  673.     autoName[0] = '\0';
  674.     resultName = NULL;
  675.     
  676.     if (argc == 2) {
  677.     numArgs:
  678.     Tcl_AppendResult(interp,
  679.         "wrong # args: should be \"", argv[0], " ", argv[1],
  680.         " ?options? code\"",(char *) NULL);
  681.     return TCL_ERROR;
  682.     } 
  683.  
  684.     argv += 2;
  685.     argc -= 2;
  686.  
  687.     /*
  688.      * Do the argument parsing.
  689.      */
  690.     
  691.     while (argc > 0) {
  692.         
  693.     if (*argv[0] == '-') {
  694.         c = *(argv[0] + 1);
  695.             
  696.         /*
  697.          * "--" is the only switch that has no value, stops processing
  698.          */
  699.             
  700.         if (c == '-' && *(argv[0] + 2) == '\0') {
  701.         argv += 1;
  702.         argc--;
  703.         break;
  704.         }
  705.             
  706.         /*
  707.          * So we can check here a switch with no value.
  708.          */
  709.             
  710.         if (argc == 1)  {
  711.         Tcl_AppendResult(interp,
  712.             "no value given for switch: ",
  713.             argv[0], (char *) NULL);
  714.         return TCL_ERROR;
  715.         }
  716.             
  717.         if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
  718.         if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) {
  719.             return TCL_ERROR;
  720.         }
  721.         } else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) {
  722.         /*
  723.          * Augment the current context which implies making a context.
  724.          */
  725.  
  726.         if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) {
  727.             return TCL_ERROR;
  728.         }
  729.         makeContext = 1;
  730.         } else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
  731.         resultName = argv[1];
  732.         } else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
  733.         /*
  734.          * Since this implies we are compiling into a context, 
  735.          * set makeContext here
  736.          */
  737.         if (tclOSAGetContextID(OSAComponent,
  738.             argv[1], &parentID) != TCL_OK) {
  739.             Tcl_AppendResult(interp, "context not found \"",
  740.                 argv[1], "\"", (char *) NULL);
  741.             return TCL_ERROR;
  742.         }
  743.         makeContext = 1;
  744.         } else {
  745.         Tcl_AppendResult(interp, "bad option \"", argv[0],
  746.             "\": should be -augment, -context, -name or -parent",
  747.              (char *) NULL);
  748.         return TCL_ERROR;
  749.         }
  750.         argv += 2;
  751.         argc -= 2;
  752.             
  753.     } else {
  754.         break;
  755.     }
  756.     }
  757.  
  758.     /*
  759.      * Make sure we have some data left...
  760.      */
  761.     if (argc == 0) {
  762.     goto numArgs;
  763.     }
  764.     
  765.     /* 
  766.      * Now if we are making a context, see if it is a new one... 
  767.      * There are three options here:
  768.      * 1) There was no name provided, so we autoName it
  769.      * 2) There was a name, then check and see if it already exists
  770.      *  a) If yes, then makeNewContext is false
  771.      *  b) Otherwise we are making a new context
  772.      */
  773.  
  774.     if (makeContext) {
  775.     modeFlags |= kOSAModeCompileIntoContext;
  776.     if (resultName == NULL) {
  777.         /*
  778.          * Auto name the new context.
  779.          */
  780.         resultName = autoName;
  781.         resultID = kOSANullScript;
  782.         makeNewContext = true;
  783.     } else if (tclOSAGetContextID(OSAComponent,
  784.         resultName, &resultID) == TCL_OK) {
  785.         makeNewContext = false;
  786.     } else { 
  787.         makeNewContext = true;
  788.         resultID = kOSANullScript;
  789.     }
  790.         
  791.     /*
  792.      * Deal with the augment now...
  793.      */
  794.     if (augment && !makeNewContext) {
  795.         modeFlags |= kOSAModeAugmentContext;
  796.     }
  797.     }
  798.     
  799.     /*
  800.      * Ok, now we have the options, so we can compile the script data.
  801.      */
  802.             
  803.     if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
  804.     Tcl_DStringResult(interp, &scrptData);
  805.     AEDisposeDesc(&scrptDesc);
  806.     return TCL_ERROR;
  807.     }
  808.  
  809.     /* 
  810.      * If we want to use a parent context, we have to make the context 
  811.      * by hand. Note, parentID is only specified when you make a new context. 
  812.      */
  813.     
  814.     if (parentID != kOSANullScript && makeNewContext) {
  815.     AEDesc contextDesc = { typeNull, NULL };
  816.  
  817.     osaErr = OSAMakeContext(OSAComponent->theComponent,
  818.         &contextDesc, parentID, &resultID);
  819.     modeFlags |= kOSAModeAugmentContext;
  820.     }
  821.     
  822.     osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
  823.         modeFlags, &resultID);                                
  824.     if (osaErr == noErr) {
  825.      
  826.     if (makeContext) {
  827.         /* 
  828.          * For the compiled context to be active, you need to run 
  829.          * the code that is in the context.
  830.          */
  831.         OSAID activateID;
  832.  
  833.         osaErr = OSAExecute(OSAComponent->theComponent, resultID,
  834.             resultID, kOSAModeCanInteract, &activateID);
  835.         OSADispose(OSAComponent->theComponent, activateID);
  836.  
  837.         if (osaErr == noErr) {
  838.         if (makeNewContext) {
  839.             /*
  840.              * If we have compiled into a context, 
  841.              * this is added to the context table 
  842.              */
  843.                      
  844.             tclOSAAddContext(OSAComponent, resultName, resultID);
  845.         }
  846.                 
  847.         Tcl_SetResult(interp, resultName, TCL_VOLATILE);
  848.         tclError = TCL_OK;
  849.         }
  850.     } else {
  851.         /*
  852.          * For a script, we return the script name.
  853.          */
  854.         tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID);
  855.         Tcl_SetResult(interp, resultName, TCL_VOLATILE);
  856.         tclError = TCL_OK;    
  857.     }
  858.     }
  859.     
  860.     /* 
  861.      * This catches the error either from the original compile, 
  862.      * or from the execute in case makeContext == true
  863.      */
  864.                              
  865.     if (osaErr == errOSAScriptError) {
  866.     OSADispose(OSAComponent->theComponent, resultID);
  867.     tclOSAASError(interp, OSAComponent->theComponent,
  868.         Tcl_DStringValue(&scrptData));
  869.     tclError = TCL_ERROR;
  870.     } else if (osaErr != noErr)  {
  871.     sprintf(buffer, "Error #%-6d compiling script", osaErr);
  872.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  873.     tclError = TCL_ERROR;        
  874.     } 
  875.  
  876.     Tcl_DStringFree(&scrptData);
  877.     AEDisposeDesc(&scrptDesc);
  878.     
  879.     return tclError;
  880. }
  881.  
  882. /*
  883.  *----------------------------------------------------------------------
  884.  *
  885.  * tclOSADecompileCmd --
  886.  *
  887.  *     This implements the Decompile subcommand of the component command
  888.  *
  889.  * Results:
  890.  *    A standard Tcl result.
  891.  *
  892.  * Side Effects:
  893.  *      Decompiles the script, and sets interp's result to the
  894.  *    decompiled script data.
  895.  *
  896.  *----------------------------------------------------------------------
  897.  */
  898.          
  899. static int 
  900. tclOSADecompileCmd(
  901.     Tcl_Interp * interp,
  902.     tclOSAComponent *OSAComponent,
  903.     int argc, 
  904.     char **argv)
  905. {
  906.     AEDesc resultingSourceData = { typeChar, NULL };
  907.     OSAID scriptID;
  908.     Boolean isContext;
  909.     long result;
  910.     OSErr sysErr = noErr;
  911.          
  912.     if (argc == 2) {
  913.     Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  914.         argv[0], " ",argv[1], " scriptName \"", (char *) NULL );
  915.     return TCL_ERROR;
  916.     }
  917.      
  918.     if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) {
  919.     Tcl_AppendResult(interp,
  920.         "Error, this component does not support get source",
  921.         (char *) NULL);
  922.     return TCL_ERROR;
  923.     }
  924.      
  925.     if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) {
  926.     isContext = false;
  927.     } else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID)
  928.         == TCL_OK ) {
  929.     isContext = true;
  930.     } else { 
  931.     Tcl_AppendResult(interp, "Could not find script \"",
  932.         argv[2], "\"", (char *) NULL);
  933.     return TCL_ERROR;
  934.     }
  935.     
  936.     OSAGetScriptInfo(OSAComponent->theComponent, scriptID,
  937.         kOSACanGetSource, &result);
  938.                         
  939.     sysErr = OSAGetSource(OSAComponent->theComponent, 
  940.         scriptID, typeChar, &resultingSourceData);
  941.     
  942.     if (sysErr == noErr) {
  943.     Tcl_DString theResult;
  944.     Tcl_DStringInit(&theResult);
  945.  
  946.     Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle,
  947.         GetHandleSize(resultingSourceData.dataHandle));
  948.     Tcl_DStringResult(interp, &theResult);
  949.     AEDisposeDesc(&resultingSourceData);
  950.     return TCL_OK;
  951.     } else {
  952.     Tcl_AppendResult(interp, "Error getting source data", (char *) NULL);
  953.     AEDisposeDesc(&resultingSourceData);
  954.     return TCL_ERROR;
  955.     }
  956. }            
  957.          
  958. /*
  959.  *----------------------------------------------------------------------
  960.  *
  961.  * tclOSADeleteCmd --
  962.  *
  963.  *    This implements the Delete subcommand of the Component command.
  964.  *
  965.  * Results:
  966.  *    A standard Tcl result.
  967.  *
  968.  * Side Effects:
  969.  *      Deletes a script from the script list of the given component.
  970.  *    Removes all references to the script, and frees the memory
  971.  *    associated with it.
  972.  *
  973.  *----------------------------------------------------------------------
  974.  */
  975.  
  976. static int 
  977. tclOSADeleteCmd(
  978.     Tcl_Interp *interp,
  979.     tclOSAComponent *OSAComponent,
  980.     int argc,
  981.     char **argv)
  982. {
  983.     char c,*errMsg = NULL;
  984.     int length;
  985.      
  986.     if (argc < 4) {
  987.     Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  988.         argv[0], " ", argv[1], " what scriptName", (char *) NULL);
  989.     return TCL_ERROR;
  990.     }
  991.      
  992.     c = *argv[2];
  993.     length = strlen(argv[2]);
  994.     if (c == 'c' && strncmp(argv[2], "context", length) == 0) {
  995.     if (strcmp(argv[3], "global") == 0) {
  996.         Tcl_AppendResult(interp, "You cannot delete the global context",
  997.             (char *) NULL);
  998.         return TCL_ERROR;
  999.     } else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) {
  1000.         Tcl_AppendResult(interp, "Error deleting script \"", argv[2],
  1001.             "\": ", errMsg, (char *) NULL);
  1002.         ckfree(errMsg);
  1003.         return TCL_ERROR;
  1004.     }
  1005.     } else if (c == 's' && strncmp(argv[2], "script", length) == 0) {
  1006.     if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) {
  1007.         Tcl_AppendResult(interp, "Error deleting script \"", argv[3],
  1008.             "\": ", errMsg, (char *) NULL);
  1009.         ckfree(errMsg);
  1010.         return TCL_ERROR;
  1011.     }
  1012.     } else {
  1013.     Tcl_AppendResult(interp,"Unknown value ", argv[2],
  1014.         " should be one of ",
  1015.         "\"context\" or \"script\".",
  1016.         (char *) NULL );
  1017.     return TCL_ERROR;
  1018.     }
  1019.     return TCL_OK;
  1020. }
  1021.  
  1022. /*
  1023.  *---------------------------------------------------------------------- 
  1024.  *
  1025.  * tclOSAExecuteCmd --
  1026.  *
  1027.  *    This implements the execute subcommand of the component command.
  1028.  *
  1029.  * Results:
  1030.  *    A standard Tcl result.
  1031.  *
  1032.  * Side effects:
  1033.  *    Executes the given script data, and sets interp's result to
  1034.  *    the OSA component's return value.
  1035.  *
  1036.  *---------------------------------------------------------------------- 
  1037.  */
  1038.  
  1039. static int 
  1040. tclOSAExecuteCmd(
  1041.     Tcl_Interp *interp,
  1042.     tclOSAComponent *OSAComponent,
  1043.     int argc,
  1044.     char **argv)
  1045. {
  1046.     int tclError = TCL_OK, resID = 128;
  1047.     char c,buffer[32],
  1048.     *contextName = NULL,*scriptName = NULL, *resName = NULL;
  1049.     Boolean makeNewContext = false,makeContext = false;
  1050.     AEDesc scrptDesc = { typeNull, NULL };
  1051.     long modeFlags = kOSAModeCanInteract;
  1052.     OSAID resultID = kOSANullScript,
  1053.     contextID = kOSANullScript,
  1054.     parentID = kOSANullScript;
  1055.     Tcl_DString scrptData;
  1056.     OSAError osaErr = noErr;
  1057.     OSErr  sysErr = noErr;
  1058.  
  1059.     if (argc == 2) {
  1060.     Tcl_AppendResult(interp,
  1061.         "Error, no script data for \"", argv[0],
  1062.         " run\"", (char *) NULL);
  1063.     return TCL_ERROR;
  1064.     } 
  1065.  
  1066.     argv += 2;
  1067.     argc -= 2;
  1068.  
  1069.     /*
  1070.      * Set the context to the global context by default.
  1071.      * Then parse the argument list for switches
  1072.      */
  1073.     tclOSAGetContextID(OSAComponent, "global", &contextID);
  1074.     
  1075.     while (argc > 0) {
  1076.         
  1077.     if (*argv[0] == '-') {
  1078.         c = *(argv[0] + 1);
  1079.  
  1080.         /*
  1081.          * "--" is the only switch that has no value.
  1082.          */
  1083.             
  1084.         if (c == '-' && *(argv[0] + 2) == '\0') {
  1085.         argv += 1;
  1086.         argc--;
  1087.         break;
  1088.         }
  1089.             
  1090.         /*
  1091.          * So we can check here for a switch with no value.
  1092.          */
  1093.             
  1094.         if (argc == 1)  {
  1095.         Tcl_AppendResult(interp,
  1096.             "Error, no value given for switch ",
  1097.             argv[0], (char *) NULL);
  1098.         return TCL_ERROR;
  1099.         }
  1100.             
  1101.         if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
  1102.         if (tclOSAGetContextID(OSAComponent,
  1103.             argv[1], &contextID) == TCL_OK) {
  1104.         } else {
  1105.             Tcl_AppendResult(interp, "Script context \"",
  1106.                 argv[1], "\" not found", (char *) NULL);
  1107.             return TCL_ERROR;
  1108.         }
  1109.         } else { 
  1110.         Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
  1111.             " should be \"-context\"", (char *) NULL);
  1112.         return TCL_ERROR;
  1113.         }
  1114.             
  1115.         argv += 2;
  1116.         argc -= 2;
  1117.     } else {
  1118.         break;
  1119.     }
  1120.     }
  1121.     
  1122.     if (argc == 0) {
  1123.     Tcl_AppendResult(interp, "Error, no script data", (char *) NULL);
  1124.     return TCL_ERROR;
  1125.     }
  1126.         
  1127.     if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
  1128.     Tcl_DStringResult(interp, &scrptData);
  1129.     AEDisposeDesc(&scrptDesc);
  1130.     return TCL_ERROR;
  1131.     }
  1132.     /*
  1133.      * Now try to compile and run, but check to make sure the
  1134.      * component supports the one shot deal
  1135.      */
  1136.     if (OSAComponent->componentFlags && kOSASupportsConvenience) {
  1137.     osaErr = OSACompileExecute(OSAComponent->theComponent,
  1138.         &scrptDesc, contextID, modeFlags, &resultID);
  1139.     } else {
  1140.     /*
  1141.      * If not, we have to do this ourselves
  1142.      */
  1143.     if (OSAComponent->componentFlags && kOSASupportsCompiling) {
  1144.         OSAID compiledID = kOSANullScript;
  1145.         osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
  1146.             modeFlags, &compiledID);
  1147.         if (osaErr == noErr) {
  1148.         osaErr = OSAExecute(OSAComponent->theComponent, compiledID,
  1149.             contextID, modeFlags, &resultID);
  1150.         }
  1151.         OSADispose(OSAComponent->theComponent, compiledID);
  1152.     } else {
  1153.         /*
  1154.          * The scripting component had better be able to load text data...
  1155.          */
  1156.         OSAID loadedID = kOSANullScript;
  1157.             
  1158.         scrptDesc.descriptorType = OSAComponent->languageID;
  1159.         osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc,
  1160.             modeFlags, &loadedID);
  1161.         if (osaErr == noErr) {
  1162.         OSAExecute(OSAComponent->theComponent, loadedID,
  1163.             contextID, modeFlags, &resultID);
  1164.         }
  1165.         OSADispose(OSAComponent->theComponent, loadedID);
  1166.     }
  1167.     }
  1168.     if (osaErr == errOSAScriptError) {
  1169.     tclOSAASError(interp, OSAComponent->theComponent,
  1170.         Tcl_DStringValue(&scrptData));
  1171.     tclError = TCL_ERROR;
  1172.     } else if (osaErr != noErr) {
  1173.     sprintf(buffer, "Error #%-6d compiling script", osaErr);
  1174.     Tcl_AppendResult(interp, buffer, (char *) NULL);
  1175.     tclError = TCL_ERROR;        
  1176.     } else  {
  1177.     tclOSAResultFromID(interp, OSAComponent->theComponent, resultID);
  1178.     osaErr = OSADispose(OSAComponent->theComponent, resultID);
  1179.     tclError = TCL_OK;
  1180.     } 
  1181.  
  1182.     Tcl_DStringFree(&scrptData);
  1183.     AEDisposeDesc(&scrptDesc);    
  1184.  
  1185.     return tclError;    
  1186. } 
  1187.  
  1188. /*
  1189.  *----------------------------------------------------------------------
  1190.  *
  1191.  * tclOSAInfoCmd --
  1192.  *
  1193.  * This implements the Info subcommand of the component command
  1194.  *
  1195.  * Results:
  1196.  *    A standard Tcl result.
  1197.  *
  1198.  * Side effects:
  1199.  *    Info on scripts and contexts.  See the user documentation for details.
  1200.  *
  1201.  *----------------------------------------------------------------------
  1202.  */
  1203. static int 
  1204. tclOSAInfoCmd(
  1205.     Tcl_Interp *interp,
  1206.     tclOSAComponent *OSAComponent,
  1207.     int argc, 
  1208.     char **argv)
  1209. {
  1210.     char c;
  1211.     int length;
  1212.     Tcl_DString theResult;
  1213.     
  1214.     if (argc == 2) {
  1215.     Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  1216.         argv[0], " ", argv[1], " what \"", (char *) NULL );
  1217.     return TCL_ERROR;
  1218.     }
  1219.      
  1220.     c = *argv[2];
  1221.     length = strlen(argv[2]);
  1222.     if (c == 's' && strncmp(argv[2], "scripts", length) == 0) {
  1223.     Tcl_DStringInit(&theResult);
  1224.     if (argc == 3) {
  1225.         getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL,
  1226.             &theResult);
  1227.     } else if (argc == 4) {
  1228.         getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult);
  1229.     } else {
  1230.         Tcl_AppendResult(interp, "Error: wrong # of arguments,",
  1231.             " should be \"", argv[0], " ", argv[1], " ",
  1232.             argv[2], " ?pattern?", (char *) NULL);
  1233.         return TCL_ERROR;
  1234.     }
  1235.     Tcl_DStringResult(interp, &theResult);
  1236.     return TCL_OK;            
  1237.     } else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) {
  1238.     Tcl_DStringInit(&theResult);        
  1239.     if (argc == 3) {
  1240.         getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL,
  1241.            &theResult);
  1242.     } else if (argc == 4) {
  1243.         getSortedHashKeys(&OSAComponent->contextTable,
  1244.             argv[3], &theResult);
  1245.     } else {
  1246.         Tcl_AppendResult(interp, "Error: wrong # of arguments for ,",
  1247.             " should be \"", argv[0], " ", argv[1], " ",
  1248.             argv[2], " ?pattern?", (char *) NULL);
  1249.         return TCL_ERROR;
  1250.     }
  1251.     Tcl_DStringResult(interp, &theResult);
  1252.     return TCL_OK;            
  1253.     } else if (c == 'l' && strncmp(argv[2], "language", length) == 0) {
  1254.     Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC);
  1255.     return TCL_OK;
  1256.     } else {
  1257.     Tcl_AppendResult(interp, "Unknown argument \"", argv[2],
  1258.         "\" for \"", argv[0], " info \", should be one of ",
  1259.         "\"scripts\" \"language\", or \"contexts\"",
  1260.         (char *) NULL);
  1261.     return TCL_ERROR;
  1262.     } 
  1263. }
  1264.         
  1265. /*
  1266.  *----------------------------------------------------------------------
  1267.  *
  1268.  * tclOSALoadCmd --
  1269.  *
  1270.  *    This is the load subcommand for the Component Command
  1271.  *
  1272.  *
  1273.  * Results:
  1274.  *    A standard Tcl result.
  1275.  *
  1276.  * Side effects:
  1277.  *    Loads script data from the given file, creates a new context
  1278.  *    for it, and sets interp's result to the name of the new context.
  1279.  *
  1280.  *----------------------------------------------------------------------
  1281.  */
  1282.  
  1283. static int 
  1284. tclOSALoadCmd(
  1285.     Tcl_Interp *interp,
  1286.     tclOSAComponent *OSAComponent,
  1287.     int argc,
  1288.     char **argv)
  1289. {
  1290.     int tclError = TCL_OK, resID = 128;
  1291.     char c, autoName[24],
  1292.     *contextName = NULL, *scriptName = NULL, *resName = NULL;
  1293.     Boolean makeNewContext = false, makeContext = false;
  1294.     AEDesc scrptDesc = { typeNull, NULL };
  1295.     long modeFlags = kOSAModeCanInteract;
  1296.     OSAID resultID = kOSANullScript,
  1297.     contextID = kOSANullScript,
  1298.     parentID = kOSANullScript;
  1299.     OSAError osaErr = noErr;
  1300.     OSErr  sysErr = noErr;
  1301.     long scptInfo;
  1302.     
  1303.     autoName[0] = '\0';
  1304.     scriptName = autoName;
  1305.     contextName = autoName;
  1306.     
  1307.     if (argc == 2) {
  1308.     Tcl_AppendResult(interp,
  1309.         "Error, no data for \"", argv[0], " ", argv[1],
  1310.         "\"", (char *) NULL);
  1311.     return TCL_ERROR;
  1312.     } 
  1313.  
  1314.     argv += 2;
  1315.     argc -= 2;
  1316.  
  1317.     /*
  1318.      * Do the argument parsing.
  1319.      */
  1320.     
  1321.     while (argc > 0) {
  1322.         
  1323.     if (*argv[0] == '-') {
  1324.         c = *(argv[0] + 1);
  1325.             
  1326.         /*
  1327.          * "--" is the only switch that has no value.
  1328.          */
  1329.             
  1330.         if (c == '-' && *(argv[0] + 2) == '\0') {
  1331.         argv += 1;
  1332.         argc--;
  1333.         break;
  1334.         }
  1335.             
  1336.         /*
  1337.          * So we can check here a switch with no value.
  1338.          */
  1339.             
  1340.         if (argc == 1)  {
  1341.         Tcl_AppendResult(interp, "Error, no value given for switch ",
  1342.             argv[0], (char *) NULL);
  1343.         return TCL_ERROR;
  1344.         }
  1345.             
  1346.         if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
  1347.         resName = argv[1];
  1348.         } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
  1349.         if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
  1350.             Tcl_AppendResult(interp,
  1351.                 "Error getting resource ID", (char *) NULL);
  1352.             return TCL_ERROR;
  1353.         }
  1354.         } else {
  1355.         Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
  1356.             " should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
  1357.             (char *) NULL);
  1358.         return TCL_ERROR;
  1359.         }
  1360.             
  1361.         argv += 2;
  1362.         argc -= 2;
  1363.     } else {
  1364.         break;
  1365.     }
  1366.     }
  1367.     /*
  1368.      * Ok, now we have the options, so we can load the resource,
  1369.      */
  1370.     if (argc == 0) {
  1371.     Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL);
  1372.     return TCL_ERROR;
  1373.     }
  1374.     
  1375.     if (tclOSALoad(interp, OSAComponent, resName, resID,
  1376.         argv[0], &resultID) != TCL_OK) {
  1377.     Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
  1378.     return TCL_ERROR;
  1379.     }
  1380.      
  1381.     /*
  1382.      *  Now find out whether we have a script, or a script context.
  1383.      */
  1384.      
  1385.     OSAGetScriptInfo(OSAComponent->theComponent, resultID,
  1386.         kOSAScriptIsTypeScriptContext, &scptInfo);
  1387.     
  1388.     if (scptInfo) {
  1389.     autoName[0] = '\0';
  1390.     tclOSAAddContext(OSAComponent, autoName, resultID);
  1391.         
  1392.     Tcl_SetResult(interp, autoName, TCL_VOLATILE);
  1393.     } else {
  1394.     /*
  1395.      * For a script, we return the script name
  1396.      */
  1397.     autoName[0] = '\0';
  1398.     tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID);
  1399.     Tcl_SetResult(interp, autoName, TCL_VOLATILE);
  1400.     }             
  1401.     return TCL_OK;
  1402. }
  1403.  
  1404. /*
  1405.  *----------------------------------------------------------------------
  1406.  *
  1407.  * tclOSARunCmd --
  1408.  *
  1409.  *    This implements the run subcommand of the component command
  1410.  *
  1411.  * Results:
  1412.  *    A standard Tcl result.
  1413.  *
  1414.  * Side effects:
  1415.  *    Runs the given compiled script, and returns the OSA
  1416.  *    component's result.
  1417.  *
  1418.  *----------------------------------------------------------------------
  1419.  */
  1420.  
  1421. static int 
  1422. tclOSARunCmd(
  1423.     Tcl_Interp *interp,
  1424.     tclOSAComponent *OSAComponent,
  1425.     int argc,
  1426.     char **argv)
  1427. {
  1428.     int tclError = TCL_OK,
  1429.     resID = 128;
  1430.     char c, *contextName = NULL,
  1431.     *scriptName = NULL, 
  1432.     *resName = NULL;
  1433.     AEDesc scrptDesc = { typeNull, NULL };
  1434.     long modeFlags = kOSAModeCanInteract;
  1435.     OSAID resultID = kOSANullScript,
  1436.     contextID = kOSANullScript,
  1437.     parentID = kOSANullScript;
  1438.     OSAError osaErr = noErr;
  1439.     OSErr sysErr = noErr;
  1440.     char *componentName = argv[0];
  1441.     OSAID scriptID;
  1442.     
  1443.     if (argc == 2) {
  1444.     Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
  1445.         argv[0], " ", argv[1], " scriptName", (char *) NULL);
  1446.     return TCL_ERROR;
  1447.     }
  1448.     
  1449.     /*
  1450.      * Set the context to the global context for this component,
  1451.      * as a default
  1452.      */
  1453.     if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) {
  1454.     Tcl_AppendResult(interp,
  1455.         "Could not find the global context for component ",
  1456.         OSAComponent->theName, (char *) NULL );
  1457.     return TCL_ERROR;
  1458.     }
  1459.  
  1460.     /*
  1461.      * Now parse the argument list for switches
  1462.      */
  1463.     argv += 2;
  1464.     argc -= 2;
  1465.     
  1466.     while (argc > 0) {
  1467.     if (*argv[0] == '-') {
  1468.         c = *(argv[0] + 1);
  1469.         /*
  1470.          * "--" is the only switch that has no value
  1471.          */
  1472.         if (c == '-' && *(argv[0] + 2) == '\0') {
  1473.         argv += 1;
  1474.         argc--;
  1475.         break;
  1476.         }
  1477.             
  1478.         /*
  1479.          * So we can check here for a switch with no value.
  1480.          */
  1481.         if (argc == 1)  {
  1482.         Tcl_AppendResult(interp, "Error, no value given for switch ",
  1483.             argv[0], (char *) NULL);
  1484.         return TCL_ERROR;
  1485.         }
  1486.             
  1487.         if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
  1488.         if (argc == 1) {
  1489.             Tcl_AppendResult(interp,
  1490.                 "Error - no context provided for the -context switch",
  1491.                 (char *) NULL);
  1492.             return TCL_ERROR;
  1493.         } else if (tclOSAGetContextID(OSAComponent,
  1494.             argv[1], &contextID) == TCL_OK) {
  1495.         } else {
  1496.             Tcl_AppendResult(interp, "Script context \"", argv[1],
  1497.                 "\" not found", (char *) NULL);
  1498.             return TCL_ERROR;
  1499.         } 
  1500.         } else {
  1501.         Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
  1502.             " for ", componentName,
  1503.             " should be \"-context\"", (char *) NULL);
  1504.         return TCL_ERROR;
  1505.         }
  1506.         argv += 2;
  1507.         argc -= 2;
  1508.     } else {
  1509.         break;
  1510.     }
  1511.     }
  1512.     
  1513.     if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
  1514.     if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
  1515.         Tcl_AppendResult(interp, "Could not find script \"",
  1516.             argv[2], "\"", (char *) NULL);
  1517.         return TCL_ERROR;
  1518.     }
  1519.     }
  1520.     
  1521.     sysErr = OSAExecute(OSAComponent->theComponent,
  1522.         scriptID, contextID, modeFlags, &resultID);
  1523.                             
  1524.     if (sysErr == errOSAScriptError) {
  1525.     tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL);
  1526.     tclError = TCL_ERROR;
  1527.     } else if (sysErr != noErr) {
  1528.     char buffer[32];
  1529.     sprintf(buffer, "Error #%6.6d encountered in run", sysErr);
  1530.     Tcl_SetResult(interp, buffer, TCL_VOLATILE);
  1531.     tclError = TCL_ERROR;
  1532.     } else {
  1533.     tclOSAResultFromID(interp, OSAComponent->theComponent, resultID );
  1534.     }
  1535.     OSADispose(OSAComponent->theComponent, resultID);
  1536.  
  1537.     return tclError;        
  1538. }
  1539.  
  1540. /*
  1541.  *----------------------------------------------------------------------
  1542.  *
  1543.  * tclOSAStoreCmd --
  1544.  *
  1545.  *    This implements the store subcommand of the component command
  1546.  *
  1547.  * Results:
  1548.  *    A standard Tcl result.
  1549.  *
  1550.  * Side effects:
  1551.  *    Runs the given compiled script, and returns the OSA
  1552.  *    component's result.
  1553.  *
  1554.  *----------------------------------------------------------------------
  1555.  */
  1556.  
  1557. static int 
  1558. tclOSAStoreCmd(
  1559.     Tcl_Interp *interp,
  1560.     tclOSAComponent *OSAComponent,
  1561.     int argc,
  1562.     char **argv)
  1563. {
  1564.     int tclError = TCL_OK, resID = 128;
  1565.     char c, *contextName = NULL, *scriptName = NULL, *resName = NULL;
  1566.     Boolean makeNewContext = false, makeContext = false;
  1567.     AEDesc scrptDesc = { typeNull, NULL };
  1568.     long modeFlags = kOSAModeCanInteract;
  1569.     OSAID resultID = kOSANullScript,
  1570.     contextID = kOSANullScript,
  1571.     parentID = kOSANullScript;
  1572.     OSAError osaErr = noErr;
  1573.     OSErr  sysErr = noErr;
  1574.         
  1575.     if (argc == 2) {
  1576.     Tcl_AppendResult(interp, "Error, no data for \"", argv[0],
  1577.         " ",argv[1], "\"", (char *) NULL);
  1578.     return TCL_ERROR;
  1579.     } 
  1580.  
  1581.     argv += 2;
  1582.     argc -= 2;
  1583.  
  1584.     /*
  1585.      * Do the argument parsing
  1586.      */
  1587.     
  1588.     while (argc > 0) {
  1589.     if (*argv[0] == '-') {
  1590.         c = *(argv[0] + 1);
  1591.             
  1592.         /*
  1593.          * "--" is the only switch that has no value
  1594.          */
  1595.         if (c == '-' && *(argv[0] + 2) == '\0') {
  1596.         argv += 1;
  1597.         argc--;
  1598.         break;
  1599.         }
  1600.             
  1601.         /*
  1602.          * So we can check here a switch with no value.
  1603.          */
  1604.         if (argc == 1)  {
  1605.         Tcl_AppendResult(interp,
  1606.             "Error, no value given for switch ",
  1607.             argv[0], (char *) NULL);
  1608.         return TCL_ERROR;
  1609.         }
  1610.             
  1611.         if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
  1612.         resName = argv[1];
  1613.         } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
  1614.         if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
  1615.             Tcl_AppendResult(interp,
  1616.                 "Error getting resource ID", (char *) NULL);
  1617.             return TCL_ERROR;
  1618.         }
  1619.         } else {
  1620.         Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
  1621.             " should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
  1622.             (char *) NULL);
  1623.         return TCL_ERROR;
  1624.         }
  1625.             
  1626.         argv += 2;
  1627.         argc -= 2;
  1628.     } else {
  1629.         break;
  1630.     }
  1631.     }
  1632.     /*
  1633.      * Ok, now we have the options, so we can load the resource,
  1634.      */
  1635.     if (argc != 2) {
  1636.     Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ",
  1637.         argv[0], " ", argv[1], "?option flag? scriptName fileName",
  1638.         (char *) NULL);
  1639.     return TCL_ERROR;
  1640.     }
  1641.     
  1642.     if (tclOSAStore(interp, OSAComponent, resName, resID,
  1643.         argv[0], argv[1]) != TCL_OK) {
  1644.     Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
  1645.     return TCL_ERROR;
  1646.     } else {
  1647.     Tcl_ResetResult(interp);
  1648.     tclError = TCL_OK;
  1649.     }
  1650.     
  1651.     return tclError;
  1652. }
  1653.  
  1654. /*
  1655.  *----------------------------------------------------------------------
  1656.  *
  1657.  * tclOSAMakeNewComponent --
  1658.  *
  1659.  *    Makes a command cmdName to represent a new connection to the
  1660.  *    OSA component with componentSubType scriptSubtype.
  1661.  *
  1662.  * Results: 
  1663.  *    Returns the tclOSAComponent structure for the connection.
  1664.  *
  1665.  * Side Effects: 
  1666.  *    Adds a new element to the component table.  If there is an
  1667.  *    error, then the result of the Tcl interpreter interp is set
  1668.  *    to an appropriate error message.
  1669.  *
  1670.  *----------------------------------------------------------------------
  1671.  */
  1672.  
  1673. tclOSAComponent *
  1674. tclOSAMakeNewComponent(
  1675.     Tcl_Interp *interp,
  1676.     char *cmdName,
  1677.     char *languageName, 
  1678.     OSType scriptSubtype,
  1679.     long componentFlags) 
  1680. {
  1681.     char buffer[32];
  1682.     AEDesc resultingName = {typeNull, NULL};
  1683.     AEDesc nullDesc = {typeNull, NULL };
  1684.     OSAID globalContext;
  1685.     char global[] = "global";
  1686.     int nbytes;
  1687.     ComponentDescription requestedComponent = {
  1688.     kOSAComponentType,
  1689.     (OSType) 0,
  1690.     (OSType) 0,
  1691.     (long int) 0,
  1692.     (long int) 0
  1693.     };
  1694.     Tcl_HashTable *ComponentTable;
  1695.     Component foundComponent = NULL;
  1696.     OSAActiveUPP myActiveProcUPP;
  1697.             
  1698.     tclOSAComponent *newComponent;
  1699.     Tcl_HashEntry *hashEntry;
  1700.     int newPtr;
  1701.     
  1702.     requestedComponent.componentSubType = scriptSubtype;
  1703.     nbytes = sizeof(tclOSAComponent);
  1704.     newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent));
  1705.     if (newComponent == NULL) {
  1706.     goto CleanUp;
  1707.     }
  1708.     
  1709.     foundComponent = FindNextComponent(0, &requestedComponent);
  1710.     if (foundComponent == 0) {
  1711.     Tcl_AppendResult(interp,
  1712.         "Could not find component of requested type", (char *) NULL);
  1713.     goto CleanUp;
  1714.     } 
  1715.     
  1716.     newComponent->theComponent = OpenComponent(foundComponent); 
  1717.     
  1718.     if (newComponent->theComponent == NULL) {
  1719.     Tcl_AppendResult(interp,
  1720.         "Could not open component of the requested type",
  1721.         (char *) NULL);
  1722.     goto CleanUp;
  1723.     }
  1724.                             
  1725.     newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1);
  1726.     strcpy(newComponent->languageName,languageName);
  1727.     
  1728.     newComponent->componentFlags = componentFlags;
  1729.     
  1730.     newComponent->theInterp = interp;
  1731.     
  1732.     Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS);
  1733.     Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
  1734.         
  1735.     if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
  1736.     sprintf(buffer, "%-6.6d", globalContext);
  1737.     Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
  1738.         " context.", (char *) NULL);
  1739.     goto CleanUp;
  1740.     }
  1741.     
  1742.     newComponent->languageID = scriptSubtype;
  1743.     
  1744.     newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 );
  1745.     strcpy(newComponent->theName, cmdName);
  1746.  
  1747.     Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd,
  1748.         (ClientData) newComponent, tclOSAClose);
  1749.                     
  1750.     /*
  1751.      * Register the new component with the component table
  1752.      */ 
  1753.  
  1754.     ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
  1755.         "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
  1756.     
  1757.     if (ComponentTable == NULL) {
  1758.     Tcl_AppendResult(interp, "Error, could not get the Component Table",
  1759.         " from the Associated data.", (char *) NULL);
  1760.     return (tclOSAComponent *) NULL;
  1761.     }
  1762.     
  1763.     hashEntry = Tcl_CreateHashEntry(ComponentTable,
  1764.         newComponent->theName, &newPtr);    
  1765.     Tcl_SetHashValue(hashEntry, (ClientData) newComponent);
  1766.  
  1767.     /*
  1768.      * Set the active proc to call Tcl_DoOneEvent() while idle
  1769.      */
  1770.     if (OSAGetActiveProc(newComponent->theComponent,
  1771.         &newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) {
  1772.         /* TODO -- clean up here... */
  1773.     }
  1774.  
  1775.     myActiveProcUPP = NewOSAActiveProc(TclOSAActiveProc);
  1776.     OSASetActiveProc(newComponent->theComponent,
  1777.         myActiveProcUPP, (long) newComponent);
  1778.     return newComponent;
  1779.     
  1780.     CleanUp:
  1781.     
  1782.     ckfree((char *) newComponent);
  1783.     return (tclOSAComponent *) NULL;
  1784. }
  1785.  
  1786. /*
  1787.  *----------------------------------------------------------------------
  1788.  *
  1789.  * tclOSAClose --
  1790.  *
  1791.  *    This procedure closes the connection to an OSA component, and 
  1792.  *    deletes all the script and context data associated with it.
  1793.  *    It is the command deletion callback for the component's command.
  1794.  *
  1795.  * Results:
  1796.  *    None
  1797.  *
  1798.  * Side effects:
  1799.  *    Closes the connection, and releases all the script data.
  1800.  *
  1801.  *----------------------------------------------------------------------
  1802.  */
  1803.  
  1804. void 
  1805. tclOSAClose(
  1806.     ClientData clientData) 
  1807. {
  1808.     tclOSAComponent *theComponent = (tclOSAComponent *) clientData;
  1809.     Tcl_HashEntry *hashEntry;
  1810.     Tcl_HashSearch search;
  1811.     tclOSAScript *theScript;
  1812.     Tcl_HashTable *ComponentTable;
  1813.     
  1814.     /* 
  1815.      * Delete the context and script tables 
  1816.      * the memory for the language name, and
  1817.      * the hash entry.
  1818.      */
  1819.     
  1820.     for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search);
  1821.      hashEntry != NULL;
  1822.      hashEntry = Tcl_NextHashEntry(&search)) {
  1823.  
  1824.     theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
  1825.     OSADispose(theComponent->theComponent, theScript->scriptID);    
  1826.     ckfree((char *) theScript);
  1827.     Tcl_DeleteHashEntry(hashEntry);
  1828.     }
  1829.     
  1830.     for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search);
  1831.      hashEntry != NULL;
  1832.      hashEntry = Tcl_NextHashEntry(&search)) {
  1833.  
  1834.     Tcl_DeleteHashEntry(hashEntry);
  1835.     }
  1836.     
  1837.     ckfree(theComponent->languageName);
  1838.     ckfree(theComponent->theName);
  1839.     
  1840.     /*
  1841.      * Finally close the component
  1842.      */
  1843.     
  1844.     CloseComponent(theComponent->theComponent);
  1845.     
  1846.     ComponentTable = (Tcl_HashTable *)
  1847.     Tcl_GetAssocData(theComponent->theInterp,
  1848.         "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
  1849.     
  1850.     if (ComponentTable == NULL) {
  1851.     panic("Error, could not get the Component Table from the Associated data.");
  1852.     }
  1853.     
  1854.     hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName);
  1855.     if (hashEntry != NULL) {
  1856.     Tcl_DeleteHashEntry(hashEntry);
  1857.     }
  1858.     
  1859.     ckfree((char *) theComponent);
  1860. }
  1861.  
  1862. /*
  1863.  *----------------------------------------------------------------------
  1864.  *
  1865.  * tclOSAGetContextID  --
  1866.  *
  1867.  *    This returns the context ID, given the component name.
  1868.  *
  1869.  * Results:
  1870.  *    A context ID
  1871.  *
  1872.  * Side effects:
  1873.  *    None
  1874.  *
  1875.  *----------------------------------------------------------------------
  1876.  */
  1877.  
  1878. static int 
  1879. tclOSAGetContextID(
  1880.     tclOSAComponent *theComponent, 
  1881.     char *contextName, 
  1882.     OSAID *theContext)
  1883. {
  1884.     Tcl_HashEntry *hashEntry;
  1885.     tclOSAContext *contextStruct;
  1886.     
  1887.     if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable,
  1888.         contextName)) == NULL ) {            
  1889.     return TCL_ERROR;
  1890.     } else {
  1891.     contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
  1892.     *theContext = contextStruct->contextID;
  1893.     }
  1894.     return TCL_OK;
  1895. }
  1896.  
  1897. /*
  1898.  *----------------------------------------------------------------------
  1899.  *
  1900.  * tclOSAAddContext  --
  1901.  *
  1902.  *    This adds the context ID, with the name contextName.  If the
  1903.  *    name is passed in as a NULL string, space is malloc'ed for the
  1904.  *    string and a new name is made up, if the string is empty, you
  1905.  *    must have allocated enough space ( 24 characters is fine) for
  1906.  *    the name, which is made up and passed out.
  1907.  *
  1908.  * Results:
  1909.  *    Nothing
  1910.  *
  1911.  * Side effects:
  1912.  *    Adds the script context to the component's context table.
  1913.  *
  1914.  *----------------------------------------------------------------------
  1915.  */
  1916.  
  1917. static void 
  1918. tclOSAAddContext(
  1919.     tclOSAComponent *theComponent, 
  1920.     char *contextName,
  1921.     const OSAID theContext)
  1922. {
  1923.     static unsigned short contextIndex = 0;
  1924.     tclOSAContext *contextStruct;
  1925.     Tcl_HashEntry *hashEntry;
  1926.     int newPtr;
  1927.  
  1928.     if (contextName == NULL) {
  1929.     contextName = ckalloc(24 * sizeof(char));
  1930.     sprintf(contextName, "OSAContext%d", contextIndex++);
  1931.     } else if (*contextName == '\0') {
  1932.     sprintf(contextName, "OSAContext%d", contextIndex++);
  1933.     }
  1934.     
  1935.     hashEntry = Tcl_CreateHashEntry(&theComponent->contextTable,
  1936.         contextName, &newPtr);    
  1937.  
  1938.     contextStruct = (tclOSAContext *) ckalloc(sizeof(tclOSAContext));
  1939.     contextStruct->contextID = theContext;
  1940.     Tcl_SetHashValue(hashEntry,(ClientData) contextStruct);
  1941. }
  1942.  
  1943. /*
  1944.  *----------------------------------------------------------------------
  1945.  *
  1946.  * tclOSADeleteContext  --
  1947.  *
  1948.  *    This deletes the context struct, with the name contextName.  
  1949.  *
  1950.  * Results:
  1951.  *    A normal Tcl result
  1952.  *
  1953.  * Side effects:
  1954.  *    Removes the script context to the component's context table,
  1955.  *    and deletes the data associated with it.
  1956.  *
  1957.  *----------------------------------------------------------------------
  1958.  */
  1959.  
  1960. static int 
  1961. tclOSADeleteContext(
  1962.     tclOSAComponent *theComponent,
  1963.     char *contextName) 
  1964. {
  1965.     Tcl_HashEntry *hashEntry;
  1966.     tclOSAContext *contextStruct;
  1967.     
  1968.     hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, contextName);
  1969.     if (hashEntry == NULL) {
  1970.     return TCL_ERROR;
  1971.     }    
  1972.     /*
  1973.      * Dispose of the script context data
  1974.      */
  1975.     contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
  1976.     OSADispose(theComponent->theComponent,contextStruct->contextID);
  1977.     /*
  1978.      * Then the hash entry
  1979.      */
  1980.     ckfree((char *) contextStruct);
  1981.     Tcl_DeleteHashEntry(hashEntry);
  1982.     return TCL_OK;
  1983. }
  1984.  
  1985. /*
  1986.  *----------------------------------------------------------------------
  1987.  *
  1988.  * tclOSAMakeContext  --
  1989.  *
  1990.  *    This makes the context with name contextName, and returns the ID.
  1991.  *
  1992.  * Results:
  1993.  *    A standard Tcl result
  1994.  *
  1995.  * Side effects:
  1996.  *    Makes a new context, adds it to the context table, and returns 
  1997.  *    the new contextID in the variable theContext.
  1998.  *
  1999.  *----------------------------------------------------------------------
  2000.  */
  2001.  
  2002. static int 
  2003. tclOSAMakeContext(
  2004.     tclOSAComponent *theComponent, 
  2005.     char *contextName,
  2006.     OSAID *theContext)
  2007. {
  2008.     AEDesc contextNameDesc = {typeNull, NULL};
  2009.     OSAError osaErr = noErr;
  2010.  
  2011.     AECreateDesc(typeChar, contextName, strlen(contextName), &contextNameDesc);
  2012.     osaErr = OSAMakeContext(theComponent->theComponent, &contextNameDesc,
  2013.         kOSANullScript, theContext);
  2014.                                 
  2015.     AEDisposeDesc(&contextNameDesc);
  2016.     
  2017.     if (osaErr == noErr) {
  2018.     tclOSAAddContext(theComponent, contextName, *theContext);
  2019.     } else {
  2020.     *theContext = (OSAID) osaErr;
  2021.     return TCL_ERROR;
  2022.     }
  2023.     
  2024.     return TCL_OK;
  2025. }
  2026.  
  2027. /*
  2028.  *----------------------------------------------------------------------
  2029.  *
  2030.  * tclOSAStore --
  2031.  *
  2032.  *    This stores a script resource from the file named in fileName.
  2033.  *
  2034.  *    Most of this routine is caged from the Tcl Source, from the
  2035.  *    Tcl_MacSourceCmd routine.  This is good, since it ensures this
  2036.  *    follows the same convention for looking up files as Tcl.
  2037.  *
  2038.  * Returns
  2039.  *    A standard Tcl result.
  2040.  *
  2041.  * Side Effects:
  2042.  *    The given script data is stored in the file fileName.
  2043.  *
  2044.  *----------------------------------------------------------------------
  2045.  */
  2046.  
  2047. int
  2048. tclOSAStore(
  2049.     Tcl_Interp *interp,
  2050.     tclOSAComponent *theComponent,
  2051.     char *resourceName,
  2052.     int resourceNumber, 
  2053.     char *scriptName,
  2054.     char *fileName)
  2055. {
  2056.     Handle resHandle;
  2057.     Str255 rezName;
  2058.     int result = TCL_OK;
  2059.     short saveRef, fileRef = -1;
  2060.     char idStr[64];
  2061.     FSSpec fileSpec;
  2062.     Tcl_DString buffer;
  2063.     char *nativeName;
  2064.     OSErr myErr = noErr;
  2065.     OSAID scriptID;
  2066.     Size scriptSize;
  2067.     AEDesc scriptData;
  2068.  
  2069.     /*
  2070.      * First extract the script data
  2071.      */
  2072.     
  2073.     if (tclOSAGetScriptID(theComponent, scriptName, &scriptID) != TCL_OK ) {
  2074.     if (tclOSAGetContextID(theComponent, scriptName, &scriptID)
  2075.         != TCL_OK) {
  2076.         Tcl_AppendResult(interp, "Error getting script ",
  2077.             scriptName, (char *) NULL);
  2078.         return TCL_ERROR;
  2079.     }
  2080.     }
  2081.     
  2082.     myErr = OSAStore(theComponent->theComponent, scriptID,
  2083.         typeOSAGenericStorage, kOSAModeNull, &scriptData);
  2084.     if (myErr != noErr) {
  2085.     sprintf(idStr, "%d", myErr);
  2086.     Tcl_AppendResult(interp, "Error #", idStr,
  2087.         " storing script ", scriptName, (char *) NULL);
  2088.     return TCL_ERROR;
  2089.     }
  2090.  
  2091.     /*
  2092.      * Now try to open the output file
  2093.      */
  2094.     
  2095.     saveRef = CurResFile();
  2096.     
  2097.     if (fileName != NULL) {
  2098.     OSErr err;
  2099.         
  2100.     Tcl_DStringInit(&buffer);    
  2101.     nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
  2102.     if (nativeName == NULL) {
  2103.         return TCL_ERROR;
  2104.     }
  2105.     err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
  2106.         
  2107.     Tcl_DStringFree(&buffer);
  2108.     if ((err != noErr) && (err != fnfErr)) {
  2109.         Tcl_AppendResult(interp,
  2110.             "Error getting a location for the file: \"", 
  2111.             fileName, "\".", NULL);
  2112.         return TCL_ERROR;
  2113.     }
  2114.         
  2115.     FSpCreateResFileCompat(&fileSpec,
  2116.         'WiSH', 'osas', smSystemScript);    
  2117.     myErr = ResError();
  2118.     
  2119.     if ((myErr != noErr) && (myErr != dupFNErr)) {
  2120.         sprintf(idStr, "%d", myErr);
  2121.         Tcl_AppendResult(interp, "Error #", idStr,
  2122.             " creating new resource file ", fileName, (char *) NULL);
  2123.         result = TCL_ERROR;
  2124.         goto rezEvalCleanUp;
  2125.     }
  2126.         
  2127.     fileRef = FSpOpenResFileCompat(&fileSpec, fsRdWrPerm);
  2128.     if (fileRef == -1) {
  2129.         Tcl_AppendResult(interp, "Error reading the file: \"", 
  2130.             fileName, "\".", NULL);
  2131.         result = TCL_ERROR;
  2132.         goto rezEvalCleanUp;
  2133.     }
  2134.     UseResFile(fileRef);
  2135.     } else {
  2136.     /*
  2137.      * The default behavior will search through all open resource files.
  2138.      * This may not be the behavior you desire.  If you want the behavior
  2139.      * of this call to *only* search the application resource fork, you
  2140.      * must call UseResFile at this point to set it to the application
  2141.      * file.  This means you must have already obtained the application's 
  2142.      * fileRef when the application started up.
  2143.      */
  2144.     }
  2145.     
  2146.     /*
  2147.      * Load the resource by name 
  2148.      */
  2149.     if (resourceName != NULL) {
  2150.     strcpy((char *) rezName + 1, resourceName);
  2151.     rezName[0] = strlen(resourceName);
  2152.     resHandle = Get1NamedResource('scpt', rezName);
  2153.     myErr = ResError();
  2154.     if (resHandle == NULL) {
  2155.         /*
  2156.          * These signify either the resource or the resource
  2157.          * type were not found
  2158.          */
  2159.         if (myErr == resNotFound || myErr == noErr) {
  2160.         short uniqueID;
  2161.         while ((uniqueID = Unique1ID('scpt') ) < 128) {}
  2162.         AddResource(scriptData.dataHandle, 'scpt', uniqueID, rezName);
  2163.         WriteResource(resHandle);
  2164.         result = TCL_OK;
  2165.         goto rezEvalCleanUp;
  2166.         } else {
  2167.         /*
  2168.          * This means there was some other error, for now
  2169.          * I just bag out.
  2170.          */
  2171.         sprintf(idStr, "%d", myErr);
  2172.         Tcl_AppendResult(interp, "Error #", idStr,
  2173.             " opening scpt resource named ", resourceName,
  2174.             " in file ", fileName, (char *) NULL);
  2175.         result = TCL_ERROR;
  2176.         goto rezEvalCleanUp;
  2177.         }
  2178.     }
  2179.     /*
  2180.      * Or ID
  2181.      */ 
  2182.     } else {
  2183.     resHandle = Get1Resource('scpt', resourceNumber);
  2184.     rezName[0] = 0;
  2185.     rezName[1] = '\0';
  2186.     myErr = ResError();
  2187.     if (resHandle == NULL) {
  2188.         /*
  2189.          * These signify either the resource or the resource
  2190.          * type were not found
  2191.          */
  2192.         if (myErr == resNotFound || myErr == noErr) {
  2193.         AddResource(scriptData.dataHandle, 'scpt',
  2194.             resourceNumber, rezName);
  2195.         WriteResource(resHandle);
  2196.         result = TCL_OK;
  2197.         goto rezEvalCleanUp;
  2198.         } else {
  2199.         /*
  2200.          * This means there was some other error, for now
  2201.          * I just bag out */
  2202.         sprintf(idStr, "%d", myErr);
  2203.         Tcl_AppendResult(interp, "Error #", idStr,
  2204.             " opening scpt resource named ", resourceName,
  2205.             " in file ", fileName,(char *) NULL);
  2206.         result = TCL_ERROR;
  2207.         goto rezEvalCleanUp;
  2208.         }
  2209.     } 
  2210.     }
  2211.     
  2212.     /* 
  2213.      * We get to here if the resource exists 
  2214.      * we just copy into it... 
  2215.      */
  2216.      
  2217.     scriptSize = GetHandleSize(scriptData.dataHandle);
  2218.     SetHandleSize(resHandle, scriptSize);
  2219.     HLock(scriptData.dataHandle);
  2220.     HLock(resHandle);
  2221.     BlockMove(*scriptData.dataHandle, *resHandle,scriptSize);
  2222.     HUnlock(scriptData.dataHandle);
  2223.     HUnlock(resHandle);
  2224.     ChangedResource(resHandle);
  2225.     WriteResource(resHandle);
  2226.     result = TCL_OK;
  2227.     goto rezEvalCleanUp;
  2228.             
  2229.     rezEvalError:
  2230.     sprintf(idStr, "ID=%d", resourceNumber);
  2231.     Tcl_AppendResult(interp, "The resource \"",
  2232.         (resourceName != NULL ? resourceName : idStr),
  2233.         "\" could not be loaded from ",
  2234.         (fileName != NULL ? fileName : "application"),
  2235.         ".", NULL);
  2236.  
  2237.     rezEvalCleanUp:
  2238.     if (fileRef != -1) {
  2239.     CloseResFile(fileRef);
  2240.     }
  2241.  
  2242.     UseResFile(saveRef);
  2243.     
  2244.     return result;
  2245. }
  2246.  
  2247. /*----------------------------------------------------------------------
  2248.  *
  2249.  * tclOSALoad --
  2250.  *
  2251.  *    This loads a script resource from the file named in fileName.
  2252.  *    Most of this routine is caged from the Tcl Source, from the
  2253.  *    Tcl_MacSourceCmd routine.  This is good, since it ensures this
  2254.  *    follows the same convention for looking up files as Tcl.
  2255.  *
  2256.  * Returns
  2257.  *    A standard Tcl result.
  2258.  *
  2259.  * Side Effects:
  2260.  *    A new script element is created from the data in the file.
  2261.  *    The script ID is passed out in the variable resultID.
  2262.  *
  2263.  *----------------------------------------------------------------------
  2264.  */
  2265.  
  2266. int
  2267. tclOSALoad(
  2268.     Tcl_Interp *interp,
  2269.     tclOSAComponent *theComponent,
  2270.     char *resourceName,
  2271.     int resourceNumber, 
  2272.     char *fileName,
  2273.     OSAID *resultID)
  2274. {
  2275.     Handle sourceData;
  2276.     Str255 rezName;
  2277.     int result = TCL_OK;
  2278.     short saveRef, fileRef = -1;
  2279.     char idStr[64];
  2280.     FSSpec fileSpec;
  2281.     Tcl_DString buffer;
  2282.     char *nativeName;
  2283.  
  2284.     saveRef = CurResFile();
  2285.     
  2286.     if (fileName != NULL) {
  2287.     OSErr err;
  2288.         
  2289.     Tcl_DStringInit(&buffer);    
  2290.     nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
  2291.     if (nativeName == NULL) {
  2292.         return TCL_ERROR;
  2293.     }
  2294.     err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec);
  2295.     Tcl_DStringFree(&buffer);
  2296.     if (err != noErr) {
  2297.         Tcl_AppendResult(interp, "Error finding the file: \"", 
  2298.             fileName, "\".", NULL);
  2299.         return TCL_ERROR;
  2300.     }
  2301.             
  2302.     fileRef = FSpOpenResFileCompat(&fileSpec, fsRdPerm);
  2303.     if (fileRef == -1) {
  2304.         Tcl_AppendResult(interp, "Error reading the file: \"", 
  2305.             fileName, "\".", NULL);
  2306.         return TCL_ERROR;
  2307.     }
  2308.     UseResFile(fileRef);
  2309.     } else {
  2310.     /*
  2311.      * The default behavior will search through all open resource files.
  2312.      * This may not be the behavior you desire.  If you want the behavior
  2313.      * of this call to *only* search the application resource fork, you
  2314.      * must call UseResFile at this point to set it to the application
  2315.      * file.  This means you must have already obtained the application's 
  2316.      * fileRef when the application started up.
  2317.      */
  2318.     }
  2319.     
  2320.     /*
  2321.      * Load the resource by name or ID
  2322.      */
  2323.     if (resourceName != NULL) {
  2324.     strcpy((char *) rezName + 1, resourceName);
  2325.     rezName[0] = strlen(resourceName);
  2326.     sourceData = GetNamedResource('scpt', rezName);
  2327.     } else {
  2328.     sourceData = GetResource('scpt', (short) resourceNumber);
  2329.     }
  2330.     
  2331.     if (sourceData == NULL) {
  2332.     result = TCL_ERROR;
  2333.     } else {
  2334.     AEDesc scriptDesc;
  2335.     OSAError osaErr;
  2336.         
  2337.     scriptDesc.descriptorType = typeOSAGenericStorage;
  2338.     scriptDesc.dataHandle = sourceData;
  2339.         
  2340.     osaErr = OSALoad(theComponent->theComponent, &scriptDesc,
  2341.         kOSAModeNull, resultID);
  2342.         
  2343.     ReleaseResource(sourceData);
  2344.         
  2345.     if (osaErr != noErr) {
  2346.         result = TCL_ERROR;
  2347.         goto rezEvalError;
  2348.     }
  2349.             
  2350.     goto rezEvalCleanUp;
  2351.     }
  2352.     
  2353.     rezEvalError:
  2354.     sprintf(idStr, "ID=%d", resourceNumber);
  2355.     Tcl_AppendResult(interp, "The resource \"",
  2356.         (resourceName != NULL ? resourceName : idStr),
  2357.         "\" could not be loaded from ",
  2358.         (fileName != NULL ? fileName : "application"),
  2359.         ".", NULL);
  2360.  
  2361.     rezEvalCleanUp:
  2362.     if (fileRef != -1) {
  2363.     CloseResFile(fileRef);
  2364.     }
  2365.  
  2366.     UseResFile(saveRef);
  2367.     
  2368.     return result;
  2369. }
  2370.  
  2371. /*
  2372.  *----------------------------------------------------------------------
  2373.  *
  2374.  * tclOSAGetScriptID  --
  2375.  *
  2376.  *    This returns the context ID, gibven the component name.
  2377.  *
  2378.  * Results:
  2379.  *    A standard Tcl result
  2380.  *
  2381.  * Side effects:
  2382.  *    Passes out the script ID in the variable scriptID.
  2383.  *
  2384.  *----------------------------------------------------------------------
  2385.  */
  2386.  
  2387. static int 
  2388. tclOSAGetScriptID(
  2389.     tclOSAComponent *theComponent,
  2390.     char *scriptName,
  2391.     OSAID *scriptID) 
  2392. {
  2393.     tclOSAScript *theScript;
  2394.     
  2395.     theScript = tclOSAGetScript(theComponent, scriptName);
  2396.     if (theScript == NULL) {
  2397.     return TCL_ERROR;
  2398.     }
  2399.     
  2400.     *scriptID = theScript->scriptID;
  2401.     return TCL_OK;
  2402. }
  2403.  
  2404. /*
  2405.  *----------------------------------------------------------------------
  2406.  *
  2407.  * tclOSAAddScript  --
  2408.  *
  2409.  *    This adds a script to theComponent's script table, with the
  2410.  *    given name & ID.
  2411.  *
  2412.  * Results:
  2413.  *    A standard Tcl result
  2414.  *
  2415.  * Side effects:
  2416.  *    Adds an element to the component's script table.
  2417.  *
  2418.  *----------------------------------------------------------------------
  2419.  */
  2420.  
  2421. static int 
  2422. tclOSAAddScript(
  2423.     tclOSAComponent *theComponent,
  2424.     char *scriptName,
  2425.     long modeFlags,
  2426.     OSAID scriptID) 
  2427. {
  2428.     Tcl_HashEntry *hashEntry;
  2429.     int newPtr;
  2430.     static int scriptIndex = 0;
  2431.     tclOSAScript *theScript;
  2432.     
  2433.     if (*scriptName == '\0') {
  2434.     sprintf(scriptName, "OSAScript%d", scriptIndex++);
  2435.     }
  2436.     
  2437.     hashEntry = Tcl_CreateHashEntry(&theComponent->scriptTable,
  2438.         scriptName, &newPtr);
  2439.     if (newPtr == 0) {
  2440.     theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
  2441.     OSADispose(theComponent->theComponent, theScript->scriptID);
  2442.     } else {        
  2443.     theScript = (tclOSAScript *) ckalloc(sizeof(tclOSAScript));
  2444.     if (theScript == NULL) {
  2445.         return TCL_ERROR;
  2446.     }
  2447.     }
  2448.         
  2449.     theScript->scriptID = scriptID;
  2450.     theScript->languageID = theComponent->languageID;
  2451.     theScript->modeFlags = modeFlags;
  2452.     
  2453.     Tcl_SetHashValue(hashEntry,(ClientData) theScript);
  2454.  
  2455.     return TCL_OK;
  2456. }
  2457.  
  2458. /*
  2459.  *----------------------------------------------------------------------
  2460.  *
  2461.  * tclOSAGetScriptID  --
  2462.  *
  2463.  *    This returns the script structure, given the component and script name.
  2464.  *
  2465.  * Results:
  2466.  *    A pointer to the script structure.
  2467.  *
  2468.  * Side effects:
  2469.  *    None
  2470.  *
  2471.  *----------------------------------------------------------------------
  2472.  */
  2473.  
  2474. static tclOSAScript *
  2475. tclOSAGetScript(
  2476.     tclOSAComponent *theComponent,
  2477.     char *scriptName)
  2478. {
  2479.     Tcl_HashEntry *hashEntry;
  2480.     
  2481.     hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
  2482.     if (hashEntry == NULL) {
  2483.     return NULL;
  2484.     }
  2485.     
  2486.     return (tclOSAScript *) Tcl_GetHashValue(hashEntry);
  2487. }
  2488.  
  2489. /*
  2490.  *----------------------------------------------------------------------
  2491.  *
  2492.  * tclOSADeleteScript  --
  2493.  *
  2494.  *    This deletes the script given by scriptName.
  2495.  *
  2496.  * Results:
  2497.  *    A standard Tcl result
  2498.  *
  2499.  * Side effects:
  2500.  *    Deletes the script from the script table, and frees up the
  2501.  *    resources associated with it.  If there is an error, then
  2502.  *    space for the error message is malloc'ed, and passed out in
  2503.  *    the variable errMsg.
  2504.  *
  2505.  *----------------------------------------------------------------------
  2506.  */
  2507.  
  2508. static int
  2509. tclOSADeleteScript(
  2510.     tclOSAComponent *theComponent,
  2511.     char *scriptName,
  2512.     char *errMsg) 
  2513. {
  2514.     Tcl_HashEntry *hashEntry;
  2515.     tclOSAScript *scriptPtr;
  2516.  
  2517.     hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName);
  2518.     if (hashEntry == NULL) {
  2519.     errMsg = ckalloc(17);
  2520.     strcpy(errMsg,"Script not found");
  2521.     return TCL_ERROR;
  2522.     }
  2523.     
  2524.     scriptPtr = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
  2525.     OSADispose(theComponent->theComponent, scriptPtr->scriptID);
  2526.     ckfree((char *) scriptPtr);
  2527.     Tcl_DeleteHashEntry(hashEntry);
  2528.     return TCL_OK;
  2529. }
  2530.  
  2531. /*
  2532.  *----------------------------------------------------------------------
  2533.  *
  2534.  * TclOSAActiveProc --
  2535.  *
  2536.  *    This is passed to each component.  It is run periodically
  2537.  *    during script compilation and script execution.  It in turn
  2538.  *    calls Tcl_DoOneEvent to process the event queue.  We also call
  2539.  *    the default Active proc which will let the user cancel the script
  2540.  *    by hitting Command-.
  2541.  * 
  2542.  * Results:
  2543.  *    A standard MacOS system error
  2544.  *
  2545.  * Side effects:
  2546.  *    Any Tcl code may run while calling Tcl_DoOneEvent.
  2547.  *
  2548.  *----------------------------------------------------------------------
  2549.  */
  2550.  
  2551. static pascal OSErr 
  2552. TclOSAActiveProc(
  2553.     long refCon)
  2554. {
  2555.     tclOSAComponent *theComponent = (tclOSAComponent *) refCon;
  2556.     
  2557.     Tcl_DoOneEvent(TCL_DONT_WAIT);
  2558.     CallOSAActiveProc(theComponent->defActiveProc, theComponent->defRefCon);
  2559.     
  2560.     return noErr;
  2561. }
  2562.  
  2563. /*
  2564.  *----------------------------------------------------------------------
  2565.  *
  2566.  * ASCIICompareProc --
  2567.  *
  2568.  *    Trivial ascii compare for use with qsort.    
  2569.  *
  2570.  * Results:
  2571.  *    strcmp of the two input strings
  2572.  *
  2573.  * Side effects:
  2574.  *    None
  2575.  *
  2576.  *----------------------------------------------------------------------
  2577.  */
  2578. static int 
  2579. ASCIICompareProc(const void *first,const void *second)
  2580. {
  2581.     int order;
  2582.     
  2583.     char *firstString = *((char **) first);
  2584.     char *secondString = *((char **) second);
  2585.  
  2586.     order = strcmp(firstString, secondString);
  2587.     
  2588.     return order;
  2589. }
  2590.  
  2591. #define REALLOC_INCR 30
  2592. /*
  2593.  *----------------------------------------------------------------------
  2594.  *
  2595.  * getSortedHashKeys --
  2596.  *
  2597.  *    returns an alphabetically sorted list of the keys of the hash
  2598.  *    theTable which match the string "pattern" in the DString
  2599.  *    theResult. pattern == NULL matches all.
  2600.  *
  2601.  * Results:
  2602.  *    None
  2603.  *
  2604.  * Side effects:
  2605.  *    ReInitializes the DString theResult, then copies the names of
  2606.  *    the matching keys into the string as list elements.
  2607.  *
  2608.  *----------------------------------------------------------------------
  2609.  */
  2610.  
  2611. static void 
  2612. getSortedHashKeys(
  2613.     Tcl_HashTable *theTable,
  2614.     char *pattern,
  2615.     Tcl_DString *theResult)
  2616. {
  2617.     Tcl_HashSearch search;
  2618.     Tcl_HashEntry *hPtr;
  2619.     Boolean compare = true;
  2620.     char *keyPtr;
  2621.     static char **resultArgv = NULL;
  2622.     static int totSize = 0;
  2623.     int totElem = 0, i;
  2624.     
  2625.     if (pattern == NULL || *pattern == '\0' || 
  2626.         (*pattern == '*' && *(pattern + 1) == '\0')) {
  2627.     compare = false;
  2628.     }
  2629.     
  2630.     for (hPtr = Tcl_FirstHashEntry(theTable,&search), totElem = 0;
  2631.      hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  2632.             
  2633.     keyPtr = (char *) Tcl_GetHashKey(theTable, hPtr);
  2634.     if (!compare || Tcl_StringMatch(keyPtr, pattern)) {
  2635.         totElem++;        
  2636.         if (totElem >= totSize) {
  2637.         totSize += REALLOC_INCR;
  2638.         resultArgv = (char **) ckrealloc((char *) resultArgv,
  2639.             totSize * sizeof(char *));
  2640.         }
  2641.         resultArgv[totElem - 1] = keyPtr;
  2642.     } 
  2643.     }
  2644.         
  2645.     Tcl_DStringInit(theResult);
  2646.     if (totElem == 1) {
  2647.     Tcl_DStringAppendElement(theResult, resultArgv[0]);
  2648.     } else if (totElem > 1) {
  2649.     qsort((VOID *) resultArgv, (size_t) totElem, sizeof (char *),
  2650.         ASCIICompareProc);
  2651.  
  2652.     for (i = 0; i < totElem; i++) {
  2653.         Tcl_DStringAppendElement(theResult, resultArgv[i]);
  2654.     }
  2655.     }    
  2656. }
  2657.  
  2658. /*
  2659.  *----------------------------------------------------------------------
  2660.  *
  2661.  * prepareScriptData --
  2662.  *
  2663.  *    Massages the input data in the argv array, concating the 
  2664.  *    elements, with a " " between each, and replacing \n with \r,
  2665.  *    and \\n with "  ".  Puts the result in the the DString scrptData,
  2666.  *    and copies the result to the AEdesc scrptDesc.
  2667.  *
  2668.  * Results:
  2669.  *    Standard Tcl result
  2670.  *
  2671.  * Side effects:
  2672.  *    Creates a new Handle (with AECreateDesc) for the script data.
  2673.  *    Stores the script in scrptData, or the error message if there
  2674.  *    is an error creating the descriptor.
  2675.  *
  2676.  *----------------------------------------------------------------------
  2677.  */
  2678.  
  2679. static int
  2680. prepareScriptData(
  2681.     int argc,
  2682.     char **argv,
  2683.     Tcl_DString *scrptData,
  2684.     AEDesc *scrptDesc) 
  2685. {
  2686.     char * ptr;
  2687.     int i;
  2688.     char buffer[7];
  2689.     OSErr sysErr = noErr;
  2690.         
  2691.     Tcl_DStringInit(scrptData);
  2692.     
  2693.     for (i = 0; i < argc; i++) {
  2694.     Tcl_DStringAppend(scrptData, argv[i], -1);
  2695.     Tcl_DStringAppend(scrptData, " ", 1);
  2696.     }
  2697.  
  2698.     /*
  2699.      * First replace the \n's with \r's in the script argument
  2700.      * Also replace "\\n" with "  ".
  2701.      */
  2702.      
  2703.     for (ptr = scrptData->string; *ptr != '\0'; ptr++) {
  2704.     if (*ptr == '\n') {
  2705.         *ptr = '\r';
  2706.     } else if (*ptr == '\\') {
  2707.         if (*(ptr + 1) == '\n') {
  2708.         *ptr = ' ';
  2709.         *(ptr + 1) = ' ';
  2710.         }
  2711.     }
  2712.     }
  2713.      
  2714.     sysErr = AECreateDesc(typeChar, Tcl_DStringValue(scrptData),
  2715.         Tcl_DStringLength(scrptData), scrptDesc);
  2716.                         
  2717.     if (sysErr != noErr) {
  2718.     sprintf(buffer, "%6d", sysErr);
  2719.     Tcl_DStringFree(scrptData);
  2720.     Tcl_DStringAppend(scrptData, "Error #", 7);
  2721.     Tcl_DStringAppend(scrptData, buffer, -1);
  2722.     Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33);
  2723.     return TCL_ERROR;                    
  2724.     }
  2725.     
  2726.     return TCL_OK;
  2727. }
  2728.  
  2729. /*
  2730.  *----------------------------------------------------------------------
  2731.  *
  2732.  * tclOSAResultFromID --
  2733.  *
  2734.  *    Gets a human readable version of the result from the script ID
  2735.  *    and returns it in the result of the interpreter interp
  2736.  *
  2737.  * Results:
  2738.  *    None
  2739.  *
  2740.  * Side effects:
  2741.  *    Sets the result of interp to the human readable version of resultID.
  2742.  *  
  2743.  *
  2744.  *----------------------------------------------------------------------
  2745.  */
  2746.  
  2747. void 
  2748. tclOSAResultFromID(
  2749.     Tcl_Interp *interp,
  2750.     ComponentInstance theComponent,
  2751.     OSAID resultID )
  2752. {
  2753.     OSErr myErr = noErr;
  2754.     AEDesc resultDesc;
  2755.     Tcl_DString resultStr;
  2756.     
  2757.     Tcl_DStringInit(&resultStr);
  2758.     
  2759.     myErr = OSADisplay(theComponent, resultID, typeChar,
  2760.         kOSAModeNull, &resultDesc);
  2761.     Tcl_DStringAppend(&resultStr, (char *) *resultDesc.dataHandle,
  2762.         GetHandleSize(resultDesc.dataHandle));
  2763.     Tcl_DStringResult(interp,&resultStr);
  2764. }
  2765.  
  2766. /*
  2767.  *----------------------------------------------------------------------
  2768.  *
  2769.  * tclOSAASError --
  2770.  *
  2771.  *    Gets the error message from the AppleScript component, and adds
  2772.  *    it to interp's result. If the script data is known, will point
  2773.  *    out the offending bit of code.  This MUST BE A NULL TERMINATED
  2774.  *    C-STRING, not a typeChar.
  2775.  *
  2776.  * Results:
  2777.  *    None
  2778.  *
  2779.  * Side effects:
  2780.  *    Sets the result of interp to error, plus the relevant portion
  2781.  *    of the script.
  2782.  *
  2783.  *----------------------------------------------------------------------
  2784.  */
  2785.  
  2786. void 
  2787. tclOSAASError(
  2788.     Tcl_Interp * interp,
  2789.     ComponentInstance theComponent,
  2790.     char *scriptData )
  2791. {
  2792.     OSErr myErr = noErr;
  2793.     AEDesc errResult,errLimits;
  2794.     Tcl_DString errStr;
  2795.     DescType returnType;
  2796.     Size returnSize;
  2797.     short srcStart,srcEnd;
  2798.     char buffer[16];
  2799.     
  2800.     Tcl_DStringInit(&errStr);
  2801.     Tcl_DStringAppend(&errStr, "An AppleScript error was encountered.\n", -1); 
  2802.     
  2803.     OSAScriptError(theComponent, kOSAErrorNumber,
  2804.         typeShortInteger, &errResult);
  2805.     
  2806.     sprintf(buffer, "Error #%-6.6d\n", (short int) **errResult.dataHandle);
  2807.  
  2808.     AEDisposeDesc(&errResult);
  2809.     
  2810.     Tcl_DStringAppend(&errStr,buffer, 15);
  2811.     
  2812.     OSAScriptError(theComponent, kOSAErrorMessage, typeChar, &errResult);
  2813.     Tcl_DStringAppend(&errStr, (char *) *errResult.dataHandle,
  2814.         GetHandleSize(errResult.dataHandle));
  2815.     AEDisposeDesc(&errResult);
  2816.     
  2817.     if (scriptData != NULL) {
  2818.     int lowerB, upperB;
  2819.         
  2820.     myErr = OSAScriptError(theComponent, kOSAErrorRange,
  2821.         typeOSAErrorRange, &errResult);
  2822.         
  2823.     myErr = AECoerceDesc(&errResult, typeAERecord, &errLimits);
  2824.     myErr = AEGetKeyPtr(&errLimits, keyOSASourceStart,
  2825.         typeShortInteger, &returnType, &srcStart,
  2826.         sizeof(short int), &returnSize);
  2827.     myErr = AEGetKeyPtr(&errLimits, keyOSASourceEnd, typeShortInteger,
  2828.         &returnType, &srcEnd, sizeof(short int), &returnSize);
  2829.     AEDisposeDesc(&errResult);
  2830.     AEDisposeDesc(&errLimits);
  2831.  
  2832.     Tcl_DStringAppend(&errStr, "\nThe offending bit of code was:\n\t", -1);
  2833.     /*
  2834.      * Get the full line on which the error occured:
  2835.      */
  2836.     for (lowerB = srcStart; lowerB > 0; lowerB--) {
  2837.         if (*(scriptData + lowerB ) == '\r') {
  2838.         lowerB++;
  2839.         break;
  2840.         }
  2841.     }
  2842.         
  2843.     for (upperB = srcEnd; *(scriptData + upperB) != '\0'; upperB++) {
  2844.         if (*(scriptData + upperB) == '\r') {
  2845.         break;
  2846.         }
  2847.     }
  2848.  
  2849.     Tcl_DStringAppend(&errStr, scriptData+lowerB, srcStart - lowerB);
  2850.     Tcl_DStringAppend(&errStr, "_", 1);
  2851.     Tcl_DStringAppend(&errStr, scriptData+srcStart, upperB - srcStart);
  2852.     }
  2853.     
  2854.     Tcl_DStringResult(interp,&errStr);
  2855. }
  2856.  
  2857. /*
  2858.  *----------------------------------------------------------------------
  2859.  *
  2860.  * GetRawDataFromDescriptor --
  2861.  *
  2862.  *    Get the data from a descriptor.
  2863.  *
  2864.  * Results:
  2865.  *    None
  2866.  *
  2867.  * Side effects:
  2868.  *    None.
  2869.  *
  2870.  *----------------------------------------------------------------------
  2871.  */
  2872.  
  2873. static void
  2874. GetRawDataFromDescriptor(
  2875.     AEDesc *theDesc,
  2876.     Ptr destPtr,
  2877.     Size destMaxSize,
  2878.     Size *actSize)
  2879.   {
  2880.       Size copySize;
  2881.  
  2882.       if (theDesc->dataHandle) {
  2883.       HLock((Handle)theDesc->dataHandle);
  2884.       *actSize = GetHandleSize((Handle)theDesc->dataHandle);
  2885.       copySize = *actSize < destMaxSize ? *actSize : destMaxSize;
  2886.       BlockMove(*theDesc->dataHandle, destPtr, copySize);
  2887.       HUnlock((Handle)theDesc->dataHandle);
  2888.       } else {
  2889.       *actSize = 0;
  2890.       }
  2891.       
  2892.   }
  2893.  
  2894. /*
  2895.  *----------------------------------------------------------------------
  2896.  *
  2897.  * GetRawDataFromDescriptor --
  2898.  *
  2899.  *    Get the data from a descriptor.  Assume it's a C string.
  2900.  *
  2901.  * Results:
  2902.  *    None
  2903.  *
  2904.  * Side effects:
  2905.  *    None.
  2906.  *
  2907.  *----------------------------------------------------------------------
  2908.  */
  2909.  
  2910. static OSErr
  2911. GetCStringFromDescriptor(
  2912.     AEDesc *sourceDesc,
  2913.     char *resultStr,
  2914.     Size resultMaxSize,
  2915.     Size *resultSize)
  2916. {
  2917.     OSErr err;
  2918.     AEDesc resultDesc;
  2919.  
  2920.     resultDesc.dataHandle = nil;
  2921.                 
  2922.     err = AECoerceDesc(sourceDesc, typeChar, &resultDesc);
  2923.         
  2924.     if (!err) {
  2925.     GetRawDataFromDescriptor(&resultDesc, (Ptr) resultStr,
  2926.         resultMaxSize - 1, resultSize);
  2927.     resultStr[*resultSize] = 0;
  2928.     } else {
  2929.     err = errAECoercionFail;
  2930.     }
  2931.             
  2932.     if (resultDesc.dataHandle) {
  2933.     AEDisposeDesc(&resultDesc);
  2934.     }
  2935.     
  2936.     return err;
  2937. }
  2938.